VBA Advanced Filtering Project

Question

I am working on a project that will filter a data table by a given criteria, copy the filtered data, paste that data into a new sheet, then delete that data from the data table. This code worked great when I only had one set of criteria to filter by, however, there are 8 total criteria sets I need the dataset to be filtered by separately. Below is my current code. When I run this code nothing happens so I believe I have my If and When Loops setup incorrectly.

Any help would be appreciated. Please let me know if more explanation is needed.

Sub Test_Filter()
    
    Dim Source      As Range        ' Data to look at
    Dim Data        As Range        ' Filtered data to copy
    Dim criteria    As Range        ' Criteria for Advanced Filter
    Dim Destination As Range        ' Place to copy filtered data
    Dim Area        As Range
    Dim RC          As Worksheet
    '-----------------------------------------------
    
    Dim RL          As Variant
    'Dimension the count of all flight exception buckets
    Dim HotLI       As Variant
    Dim HotM        As Variant
    Dim HotW        As Variant
    Dim HotC        As Variant
    
    Dim ColdLI      As Variant
    Dim COldM       As Variant
    Dim ColdW       As Variant
    Dim ColdC       As Variant
    
    HotLI = Sheets("OPC Exception").Range("W18").Value
    HotM = Sheets("OPC Exception").Range("Z18").Value
    HotW = Sheets("OPC Exception").Range("AC18").Value
    HotC = Sheets("OPC Exception").Range("AF18").Value
    
    ColdLI = Sheets("OPC Exception").Range("W57").Value
    COldM = Sheets("OPC Exception").Range("Z57").Value
    ColdW = Sheets("OPC Exception").Range("AC57").Value
    ColdC = Sheets("OPC Exception").Range("AF57").Value
    '--------------------------------------------------------------------------
    'Defining values for Non Empty If statement
    
    NonEmpty_HotLI = Sheets("OPC Exception").Range("V18").Value
    NonEmpty_HotM = Sheets("OPC Exception").Range("Y18").Value
    NonEmpty_Hotw = Sheets("OPC Exception").Range("AB18").Value
    NonEmpty_HotC = Sheets("OPC Exception").Range("AE18").Value
    
    NonEmpty_ColdLI = Sheets("OPC Exception").Range("V57").Value
    NonEmpty_ColdM = Sheets("OPC Exception").Range("Y57").Value
    NonEmpty_ColdW = Sheets("OPC Exception").Range("AB57").Value
    NonEmpty_ColdC = Sheets("OPC Exception").Range("AE57").Value
    
    Set Source = Sheets("Working").Range("A1").CurrentRegion
    '--------------------------------------------------------------------------------
    'set criteria for each filter
    Set criteria_HotLI = Sheets("OPC Exception").Range("V20:W" & HotLI)
    Set criteria_HotM = Sheets("OPC Exception").Range("Y20:W" & HotM)
    Set criteria_HotW = Sheets("OPC Exception").Range("AB20:W" & HotW)
    Set criteria_HotC = Sheets("OPC Exception").Range("AE20:W" & HotC)
    
    Set criteria_ColdLI = Sheets("OPC Exception").Range("V59:V" & ColdLI)
    Set criteria_ColdM = Sheets("OPC Exception").Range("Y59:V" & COldM)
    Set criteria_ColdW = Sheets("OPC Exception").Range("AB59:V" & ColdW)
    Set criteria_ColdC = Sheets("OPC Exception").Range("AE59:V" & ColdC)
    
    '--------------------------------------------------------------------------------
    'set destination for each bucket
    
    Set Destination_Int = Sheets("International").Range("A1")
    Set Destination_Weather = Sheets("Weather").Range("A1")
    Set Destination_Mech = Sheets("Mech").Range("A1")
    Set Destination_Covid = Sheets("Covid").Range("A1")
    Set Destination_LA = Sheets("Late Air").Range("A1")
    Set Destination_K9 = Sheets("K9").Range("A1")
    Set Destination_LT = Sheets("Late Trailer").Range("A1")
    Set Destination_Cap = Sheets("Capacity").Range("A1")
    Set Destination_MF = Sheets("Misflow").Range("A1")
    Set Destination_LIB = Sheets("LIB").Range("A1")
    
    '--------------------------------------------------------------------------------
    'Start filtering Working into buckets based on If nonempty statement
    With Source
    
    If NonEmpty_HotLI = "False" Then
        
        GoTo JumpHotM
        
    ElseIf NonEmpty_HotLI = "TRUE" Then
        
      
            .AdvancedFilter xlFilterInPlace, criteria_HotLI
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then
                GoTo JumpHotM
            End If
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_LA.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
        
    End If
    
JumpHotM:
    
    If NonEmpty_HotM = "False" Then
        
        GoTo JumpHotW
        
    ElseIf NonEmpty_HotM = "True" Then
       
            .AdvancedFilter xlFilterInPlace, criteria_HotM
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpHotW
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_Mech.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
     
    End If
    
JumpHotW:
    If NonEmpty_Hotw = "False" Then
        
        GoTo JumpHotC
        
    ElseIf NonEmpty_Hotw = "True" Then
        
            .AdvancedFilter xlFilterInPlace, criteria_HotW
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpHotC
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_Weather.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
        
    End If
    
JumpHotC:
    If NonEmpty_HotC = "FALSE" Then
        
        GoTo JumpColdLI
        
    ElseIf NonEmpty_HotC = "True" Then
        
            .AdvancedFilter xlFilterInPlace, criteria_HotC
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpColdLI
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_Covid.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
      
    End If
    
JumpColdLI:
    If NonEmpty_ColdLI = "False" Then
        
        GoTo JumpColdM
        
    ElseIf NonEmpty_ColdLI = "False" Then
        
      
            .AdvancedFilter xlFilterInPlace, criteria_ColdLI
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpColdM
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_LA.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
     
    End If
    
JumpColdM:
    
    If NonEmpty_ColdM = "False" Then
        
        GoTo JumpColdW
        
    ElseIf NonEmpty_ColdM = "False" Then
        
            .AdvancedFilter xlFilterInPlace, criteria_ColdM
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpColdW
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_Mech.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
       
    End If
    
JumpColdW:
    If NonEmpty_ColdW = "False" Then
        
        GoTo JumpColdC
        
    ElseIf NonEmpty_ColdW = "True" Then
       
            .AdvancedFilter xlFilterInPlace, criteria_ColdW
            
            Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
            .Parent.ShowAllData
            
            If Data Is Nothing Then GoTo JumpColdC
            
            For Each Area In Data.Areas
                Area.Copy
                Destination_Weather.Insert xlShiftDown
            Next Area
            Data.Delete xlShiftUp
       
    End If
    
JumpColdC:
    If NonEmpty_ColdC = "False" Then
        
        GoTo JumpEnd
        
    ElseIf NonEmpty_ColdC = "True" Then
       
        
        .AdvancedFilter xlFilterInPlace, criteria_ColdC
        
        Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
        .Parent.ShowAllData
        
        If Data Is Nothing Then GoTo JumpEnd
        
        For Each Area In Data.Areas
            Area.Copy
            Destination_Covid.Insert xlShiftDown
        Next Area
        Data.Delete xlShiftUp
   
    End If
    
    End With


JumpEnd:

End Sub

I can't see your workbook as far as if your criteria is being met. But with Advanced filter, you do not need to filter then copy to another workbook. You can copy to range immediately in the function. `.AdvancedFilter xlFilterCopy, rgCriteriaRange, rgCopyToRange` — data_sc, Jun 24 '22 at 17:29
You really should restructure your `If`s so you don't need those `goto` statements. https://stackoverflow.com/questions/3517726/what-is-wrong-with-using-goto — Warcupine, Jun 24 '22 at 17:30
See [Excel Macro Mastery](https://excelmacromastery.com/vba-advanced-filter/) for good info on Advanced Filtering. — data_sc, Jun 24 '22 at 17:31
But yeah, agree with @Warcupine, you don't need the goto statements at all. Just check for = "True" and remove the "False" check with goto's altogether. — data_sc, Jun 24 '22 at 17:35
@data_sc the reason I filtered in place was to be able to delete the data that was copied from the original data table after it was copied. I wasn't sure if I could do that if I immediately copied to another worksheet — macro123, Jun 24 '22 at 17:36
@Warcupine What function can I use in place of GoTo? Do I need to add Endifs? — macro123, Jun 24 '22 at 17:38
You can just flip the logic, and your if does the same thing as the goto, just in less lines and much cleaner. So `If variable = "TRUE"` then your code block then end if. Same for `If Not Data is Nothing` then code block then end if. — Warcupine, Jun 24 '22 at 17:41
Just a suggestion, to avoid writing sheet name many times, maybe try to use the "with sheets .... end with". Something like this : `With Sheets("OPC Exception")` next line `NonEmpty_HotLI = .Range("V18").Value` next line `NonEmpty_HotM = .Range("Y18").Value` next line the same thing for the rest, then next line `Set criteria_HotLI = .Range("V20:W" & .Range("W18").Value)` next line `Set criteria_HotM = .Range("Y20:W" & .Range("Z18").Value)` next line the same thing for the rest , then close it with `end with`. — karma, Jun 24 '22 at 18:13
Just curious, is each of your NonEmpty variable value a text either "True" or "False" ? — karma, Jun 24 '22 at 18:18

karma · Answer 1 · 2022-06-24T20:37:31.870

The sub below is based on looking at your code and use 4 variables from you code just for example. Not tested in my side.

Basically, the sub do the filtering only when it meet a condition where any of your NonEmpty_ variable value is a text "True" and if the Data variable is not nothing then it do the loop for inserting and deleting.

Sub test()
Dim criteria_HotLI As Range: Dim Destination_Int As Range
Dim criteria_HotM As Range: Destination_Weather As Range
Dim criteria_HotW As Range: Dim Destination_Mech As Range
Dim criteria_HotC As Range: Destination_Covid As Range
Dim arr As Variant: Dim i As Long: Dim data As Range: Dim area As Long

With Sheets("OPC Exception")
Set criteria_HotLI = .Range("V20:W" & .Range("W18").Value)
Set criteria_HotM = .Range("Y20:W" & .Range("Z18").Value)
Set criteria_HotW = .Range("AB20:W" & .Range("AC18").Value)
Set criteria_HotC = .Range("AE20:W" & .Range("AF18").Value)
arr = Array(.Range("V18").Value, .Range("Y18").Value, .Range("AB18").Value, .Range("AE18").Value)

'or for the array using variable
'NonEmpty_HotLI = .Range("V18").Value
'NonEmpty_HotM = .Range("Y18").Value
'NonEmpty_Hotw = .Range("AB18").Value
'NonEmpty_HotC = .Range("AE18").Value
'arr = Array(NonEmpty_HotLI, NonEmpty_HotM, NonEmpty_Hotw, NonEmpty_HotC)

End With

    Set Destination_Int = Sheets("International").Range("A1")
    Set Destination_Weather = Sheets("Weather").Range("A1")
    Set Destination_Mech = Sheets("Mech").Range("A1")
    Set Destination_Covid = Sheets("Covid").Range("A1")

For i = LBound(arr) To UBound(arr)
    If arr(i) = "True" Then

        Select Case i + 1
            Case 1: Set crit = criteria_HotLI: Set dest = Destination_LA 'if NonEmpty_HotLI = "True"
            Case 2: Set crit = criteria_HotM: Set dest = Destination_Mech 'if NonEmpty_HotM = "True"
            Case 3: Set crit = criteria_HotW: Set dest = Destination_Weather 'if NonEmpty_Hotw = "True"
            Case 4: Set crit = criteria_HotC: Set dest = Destination_Covid 'if NonEmpty_HotC = "True"
        End Select
        
        With Sheets("OPC Exception") ' your code with Source ??
        .AdvancedFilter xlFilterInPlace, crit
        Set data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
        .Parent.ShowAllData
            If Not data Is Nothing Then
                For Each area In data.Areas
                    area.Copy
                    dest.Insert xlShiftDown
                Next area
                data.Delete xlShiftUp
            End If
        End With

    End If
Next i

End Sub

The sub doesn't create the NonEmpty_ variables, but directly put the each NonEmpty_ variable value into an array. Since I only use 4 condition from your code, then the array will have 4 elements where the value is either a text "True" or "False".

Then it loop to each element in the array as i.
Check if the arr(i) value = "True", then it give a value to a variable crit and variable dest regarding the range needed.

Then it filter the sheet "OPC Exception" with crit variable value (actually I don't know the name of the sheet, because in your code, you define it as Source variable. So please change the sheet name if your Source variable is not "OPC Exception").

Then it set the visible range as data variable, check if data is not nothing then it do the inserting to the dest variable value and do the deleting.

Please put attention to the order of the array, because the crit and dest variable depends on the order of the array.

This was extremely helpful. I like how you organized the code. Thanks for the help — macro123, Jun 28 '22 at 12:40

VBA Advanced Filtering Project

1 Answers1