I intend to filter values that begins with 314 in column F, and clear its contents(entire row). The workbook has 30,000+ rows and I think looping is not a good option when filtering in another sheet(sA). I recorded the following code below.
Sheets("sA").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AF$30436").AutoFilter Field:=6, Criteria1:="=314*" _
, Operator:=xlAnd
ActiveCell.Offset(-181, -2).Range("A1:AF30436").Select
ActiveCell.Activate
Selection.ClearContents
When I ran the code, a Runtime Error 1004 appears. I think because of the ActiveCell, because I ran the code in a different sheet(sB, where the button for filtering sheets in sA is found). What could be the possible fix to this? Any suggestions?
this should work ,
Sub filter()
Dim ws As Worksheet
Set ws = Sheets("sheet1")
ws.Range("$A$1:$AF$30436").AutoFilter Field:=6, Criteria1:="=314*" _
, Operator:=xlAnd
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:AF" & LR).SpecialCells(xlCellTypeVisible).ClearContents
ws.AutoFilterMode = False
End Sub
Related
I'm creating a Macro (Excel)
I'm saving the amount of rows used on the sheet via a variable and I need to pass it to a filter range, hope this code helps to explain what I'm trying to do...
Sub Filtering()
Rows("11:11").Select
Selection.AutoFilter
'save the amount of rows used on the sheet
Dim lastRow As Long
lastRow = Range("AC" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$11:$AC$lastRow").AutoFilter Field:=18, Criteria1:=">10", _
Operator:=xlAnd
End Sub
The filter will always be on row 11 and columns will always be from A to AC but the number of rows is different on each Excel file. can you guys help? pls
You are very close. Similar approach to when you defined your range for the last row. The variable has to be outside the " "
Option Explicit
Sub Filtering()
'Rows("11:11").Select 'Redudant
'Selection.AutoFilter 'Redudant
'save the amount of rows used on the sheet
Dim lastRow As Long
lastRow = Range("AC" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$11:$AC" & lastRow).AutoFilter Field:=18, Criteria1:=">10", _
Operator:=xlAnd
End Sub
Result
My macro below will filter out data starting with
PB*
However if the data PB* does not exist, I would like a message box to pop up and stop the macro completely.
I hope someone would be able to enhance the macro by adding an "If- Else" statement in it with the message
Data does not exist.
This is the macro I am currently using ...
Sub LHEQP()
'
' LHEQP Macro
'
'
Dim LastRow As Long
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell.Columns("A:A").EntireColumn.Select
ActiveSheet.Range("$A$1:$P$" & LastRow).AutoFilter Field:=14, Criteria1:="=PB**" _
, Operator:=xlAnd
End Sub
I recommend amending some options to the Range.Find method to suit your needs. Available options, and other useful info, can be found here
Dim Found as Range
Set Found = Thisworkbook.Sheets("Sheet1").Range("N:N").Find("PB*")
If Found is Nothing Then
Msgbox "Data does not exist"
Else
Thisworkbook.Sheets("Sheet1").Range("A1:P1").AutoFilter Field:=14, Criteria1:="=PB*", Operator:=xlAnd
End If
Count the visible data in column N with the worksheet's SubTotal function.
Sub LHEQP()
Dim lastRow As Long
with ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
with .Range("A1:P" & LastRow)
.AutoFilter Field:=14, Criteria1:="=PB*"
if not cbool(application.subtotal(103, .columns(14).offset(1,0))) then
'zero visible data in filtered column N
msgbox "bad filter"
exit sub
end if
end with
end with
End Sub
I am having an issue with a piece of VBA in excel and am looking for assistance.
I require a piece of code to auto populate a formula in excel through a series of data, the series will vary in length and will occupy columns C:I.
I have been using this piece of code without issue for quiet a while:
Sub Auto_Fill_Formula()
Sheets("Sheet1").Select
Dim LstRow As Long
With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:A" & LastRow).Formula = "Formula added here"
Application.CutCopyMode = False
End With
End Sub
However as the formula is being added to the leftmost column it only populates the first cell, cell A2.
How can I modify this code to work when the leftmost column is empty?
Thank you,
Wayne
You can use Find to find the last used row in C:I by searching backwards from row 1. You should also use Option Explicit to pick up typos in variable names (LstRow).
Sub Auto_Fill_Formula()
Sheets("Sheet1").Select
Dim LastRow As Long, r As Range
With Sheets("Sheet1")
Set r = .Range("C:I").Find(What:="*", After:=.Range("C1"), Lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
LastRow = r.Row
.Range("A2:A" & LastRow).Formula = "Formula added here"
End If
End With
End Sub
I have a code that successfully looks into an external file and copy/pastes the rows that contain that particular condition into the current workbook. For example I am searching for Singapore in the external workbook called Active master project file and copy all the rows containing Singapore to the current workbook that is open.
A problem that occurs is that when I run the same code twice, a border line will exist on the last row of the worksheet. For example when I run the code, it will copy paste the information containing Singapore to the current worksheet called "New Upcoming Projects":
However, when I run the code again it will create a border line on each column such as the image shown below:
And the code that I have for now is:
Sub UpdateNewUpcomingProj()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
Dim strSearch As String
Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm")
Set ws1 = wb1.Worksheets("New Upcoming Projects")
strSearch = "Singapore"
With ws1
'~~> Remove any filters
.AutoFilterMode = False
'~~> I am assuming that the names are in Col A
'~~> if not then change A below to whatever column letter
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
.AutoFilterMode = False
End With
'~~> Destination File
Set wb2 = ThisWorkbook
Set ws2 = wb2.Worksheets("New Upcoming Projects")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 2
End If
copyFrom.Copy .Rows(lRow)
.Rows.RemoveDuplicates Array(2), xlNo
End With
End Sub
Is there any improvement or additional codes that I have to add in so that the border line would disappear?
As EyePeaSea said you can remove the border by vba code, e.g.
ThisWorkbook.Worksheets("XY").Range("A1", "Z99").Borders.LineStyle = xlNone
In your case the code should be (untested)
copyFrom.Borders.LineStyle = xlNone
after you copied the row
I assume this formatting is coming from the source worksheet. If so, you could PasteSpecial to just paste values, keeping the destination formatting. To do so, simply replace
copyFrom.Copy .Rows(lRow)
with
copyFrom.Copy
.Rows(lRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
If you do need some formatting from the source sheet, you can use xlPasteAllExceptBorders instead of xlPasteValues.
Paste Special, this will paste to the first empty cell in column A
copyfrom.Copy
ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = 0
You can add this line after removing the duplicates
.UsedRange.Offset(lRow).Borders.Value = 0
This will remove any borders from the inserted rows
p.s.: I still dont understand where these borders came from, most probably from the original worksheet.. :)
At the end of the code,
please add a new line to format paint of the 3rd row.
So basically before the last two lines
wb1.Select ' please make sure you select the correct one wb1 or wb2 here and try again
Rows("3:3").Select
Selection.Copy
Rows("4:10000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
end with
end sub 'This is the last line of your code
I'm interning and was given an assignment in VBA, which I know very little about. I found code that is similar to the functions I need and have commented it with my best guesses. If you could help me understand what each piece does and where to replace the generic code with my own information, it would be greatly appreciated!
When patrons have an overdue record, they are sent a spreadsheet with a list of the records they must return and the records' attributes in the following columns.
I need to create a macro which will
Create a new workbook
Copy row 1 (headings)
Copy rows with the same User
Name the file “UniqueUserrecordsrecall.xlsx”
Save to C:\Users\xxx\Documents\xxx\xxx
Attributes: Records, Description, Client, Engagement, Days, Date, Type, LOS, Location, State, Final, User.
Workbook Name: RecordsRecall
Worksheet Name: Main
Sub details()
'Declaration
Dim thisWB As String
Dim newWB As String
thisWB = ActiveWorkbook.Name
'?
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0
'CreateTempSheet
Sheets.Add
ActiveSheet.Name = "tempsheet"
'?
Sheets("Main").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End If
'Copy User Column
Columns("L:L").Select
Selection.Copy
'Paste User Column in TempSheet
Sheets("tempsheet").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'?
If (Cells(1, 1) = "") Then
LastRow = Cells(1, 1).End(xlDown).Row
If LastRow <> Rows.Count Then
Range("A1:A" & LastRow - 1).Select
Selection.Delete Shift:=xlUp
End If
End If
'Apply Unique Filters in Tempsheet
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), Unique:=True
'?
Columns("A:A").Delete
Cells.Select
Selection.Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
For suppno = 2 To lMaxSupp
Windows(thisWB).Activate
supName = Sheets("tempsheet").Range("A" & suppno)
If supName <> "" Then
Workbooks.Add
ActiveWorkbook.SaveAs supName
newWB = ActiveWorkbook.Name
Windows(thisWB).Activate
Sheets("Main").Select
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _
Operator:=xlAnd, Criteria2:="<>"
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
'Copy from TempSheet
Rows("1:" & LastRow).Copy
'Paste in newWB in TempSheet
Windows(newWB).Activate
ActiveSheet.Paste
'Save and Close newWB
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next
'Delete TempSheet
Sheets("tempsheet").Delete
Sheets("Main").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
ActiveSheet.ShowAllData
End If
End Sub
Thanks for the help!
I am guessing this code does not achieve the effect you seek and you do not know where to start fixing it.
You are attempting too much in one go when you do not really know what you are doing.
I suggest you start by writing simple macros each of which achieves one step of your total requirement or adds one step to a previous macro. If you run into difficulties with one of these macros, you can post it with an explanation of what it does and what you want it to do. Questions with macros that isolate a single problem get answered very quickly. I would not know where to start debugging your current macro.
You have an AutoFilter but I cannot see how that selects the records of a patron with an overdue record. I think that is your first problem: how does the macro know which patron’s records are to be output? Could this be supName? Where has this come from?
Can you write a macro that creates an empty workbook and saves it with the desired name? Call that Macro1.
Write Macro2 by updating Macro1, to rename Sheet1 as “Overdue” or something more meaningful and then delete the other worksheets.
Can you write a macro that uses AutoFilter to select the required records? Write this as new macro Macro3.
Merge Macro2 and Macro3 and try copying the rows selected by AutoFilter to the new workbook. The statement SourceRange.Copy Destination:=FirstDestCell is likely to be easier to use than Copy and Paste.
I hope you can see why little macros which expand your knowledge one step at a time will be an easier path to your objective than trying to debug your current code.