I am beginner in VBA. How can I ignore if the condition or the filtered table is empty then continue with other condition?
Here is the code I currently use:
Sub Macro7()
'
' Macro7 Macro
'
Dim LastRow As Long
'
Sheets("Ref2").Select
ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=3, Criteria1:=Sheets("NOV 2022").Range("E1").Value
ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A6").Value
LastRow = Range("E" & Rows.Count).End(xlUp).Row
Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.copy
Sheets("NOV 2022").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=21
Sheets("Ref2").Select
ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A37").Value
LastRow = Range("E" & Rows.Count).End(xlUp).Row
Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.copy
Sheets("NOV 2022").Select
Range("C37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=21
Range("C58").Select
Sheets("Ref2").Select
ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A58").Value
LastRow = Range("E" & Rows.Count).End(xlUp).Row
Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.copy
Sheets("NOV 2022").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=27
Range("C93").Select
Sheets("Ref2").Select
ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A93").Value
LastRow = Range("E" & Rows.Count).End(xlUp).Row
Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.copy
Sheets("NOV 2022").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
CodePudding user response:
Copy Filtered Data (Translating Macro-Recorder Code)
Option Explicit
Sub UpdateNov2022()
Dim CriteriaAddresses() As Variant:
CriteriaAddresses = VBA.Array("E1", "A6", "A37", "A58", "A93")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Ref2")
If sws.FilterMode Then sws.ShowAllData
Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Table Range
Dim scrg As Range ' Copy Range (no headers)
With srg
Set scrg = srg.Columns("E:O").Resize(.Rows.Count - 1).Offset(1)
End With
Dim dws As Worksheet: Set dws = wb.Worksheets("NOV 2022")
Dim dcCell As Range ' Criteria Cell
Dim CriteriaString As String
Set dcCell = dws.Range(CriteriaAddresses(0))
CriteriaString = CStr(dcCell.Value)
srg.AutoFilter Field:=3, Criteria1:=CriteriaString
Dim svrg As Range ' Visible Range (no headers)
Dim dpCell As Range ' Paste Cell
Dim n As Long
For n = 1 To UBound(CriteriaAddresses)
Set dcCell = dws.Range(CriteriaAddresses(n))
CriteriaString = CStr(dcCell.Value)
srg.AutoFilter Field:=4, Criteria1:=CriteriaString
On Error Resume Next
Set svrg = scrg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not svrg Is Nothing Then
svrg.Copy
Set dpCell = dws.Cells(dcCell.Row, "C")
dpCell.PasteSpecial Paste:=xlPasteValues
Set svrg = Nothing
End If
Next n
Application.CutCopyMode = False
sws.ShowAllData ' or to remove: sws.AutoFilterMode = False
End Sub