Excel Forum

Code: Select all

Sub SelectUsableLot5()
Dim lngLastRow As Long
Dim lngLastRowSource As Long
Dim StrFilterRange As String

    Sheets("Data").Select
    
    lngLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row                  ' Get the last Target
    StrFilterRange = "$A$1:$H$" & CStr(lngLastRow)
    
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    
    Selection.AutoFilter
    ActiveSheet.Range(StrFilterRange).AutoFilter Field:=1, Criteria1:=Array("1", "2", _
                                    "4"), _
                    Operator:=xlFilterValues
    
End Sub

Code: Select all

Sub Filter()
  With Worksheets("Data")
  .AutoFilterMode = False
  With .Range("A1:H13")
  .AutoFilter
  .AutoFilter Field:=1, Criteria1:=Worksheets("Procedures").Range("C11:C13").Value
  End With
  End With
End Sub

Code: Select all

Sub test0()
    Dim rAllCri As Range, rc As Range
    Dim rt As Range, f As Boolean
    With Sheets("Procedures")
        Set rAllCri = .Range("c11", .Range("c" & .Rows.Count).End(xlUp))
    End With
    With Sheets("Data")
        .UsedRange.EntireRow.Hidden = False
        For Each rt In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            For Each rc In rAllCri
                f = False
                If rt.Value Like "*" & rc.Value & "*" Then
                    f = True
                    Exit For
                End If
            Next rc
            If Not f Then
                rt.EntireRow.Hidden = True
            End If
        Next rt
    End With
End Sub

Code: Select all

Sub test0()
    Dim rAllCri As Range, rc As Range
    Dim rt As Range, f As Boolean
    Dim rAllData As Range
    With Sheets("Procedures")
        Set rAllCri = .Range("c11", .Range("c" & .Rows.Count).End(xlUp))
    End With
    With Sheets("Data")
       Set rAllData = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
        .UsedRange.EntireRow.Hidden = False
       
        For Each rt In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            For Each rc In rAllCri
                f = False
                If rt.Value Like "*" & rc.Value & "*" Then
                    f = True
                    Exit For
                End If
            Next rc
            If Not f Then
               rt.ClearContents
            End If
            Next
             rAllData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
    End With
End Sub

Code: Select all

Sub test0()
    Dim rAllCri As Range, rc As Range
    Dim rt As Range, f As Boolean
    Dim rAllData As Range
    Dim m As Long
    
    
    With Sheets("Procedures")
        Set rAllCri = .Range("c11", .Range("c" & .Rows.Count).End(xlUp))
    End With
    
    
    With Sheets("Data")
       Set rAllData = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
        .UsedRange.EntireRow.Hidden = False
       
        
        For Each rt In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            For Each rc In rAllCri
                f = False
                If Application.CountIf(rAllCri, rt) > 0 Then
                m = Application.Match(rt, rAllCri, 0)
                f = True
                
          
                    Exit For
                End If
            Next rc
            
            
            
            If Not f Then
               rt.ClearContents
            End If
            Next
             rAllData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
    End With
End Sub