VBA 高级过滤项目

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

Answer 1

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.