Auto filter based on cell value

user_7908269 0
Viewed 125

I wanted to do an auto filter based on cell value, I got the code to work for the most part but I still stuck on 2 things

  1. I want it to be a partial match (currently it is full match)
  2. I want it to be none case sensitive (currently it is case sensitive) How do I modify the code?

Q2 in the code refer to column header and Q3 refer to the actual value (name) Thank you in advance for your help!

    Sub Filter()
    Dim FNameVal As String
    Dim cell As Range

    With Sheets("Database")
        FNameVal = .Range("Q3").Value2
        For Each cell In .Range("B6:U1000").Cells
            If FNameVal = cell.Value2 Then
                Range("B6:U1000").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Q2:Q3")
                Exit For
            End If
        Next
    End With
    
End Sub
vba excel
1 Answers

Filter a Range

Option Explicit

Sub filterRange()
    With ThisWorkbook.Worksheets("Database")
        Dim cel As Range: Set cel = .Range("B6")
        Dim rg As Range
        With cel.CurrentRegion
            Set rg = cel.Resize(.Row + .Rows.Count - cel.Row, _
                .Column + .Columns.Count - cel.Column)
        End With
        'Debug.Print rg.Address
        Dim Header As String: Header = CStr(.Range("Q2").Value)
        Dim cIndex As Variant
        cIndex = Application.Match(Header, rg.Rows(1), 0)
        If IsNumeric(cIndex) Then
            Application.ScreenUpdating = False
            .AutoFilterMode = False
            Dim Criteria As String
            Criteria = "*" & CStr(.Range("Q3").Value) & "*"
            rg.AutoFilter cIndex, Criteria
            Application.ScreenUpdating = True
        Else
            MsgBox "The range '" & rg.Address(0, 0) & "' does not contain " _
                & "the header '" & Header & "'.", vbExclamation, _
                "Header Not Found"
        End If
    End With
End Sub
user_98140690
Related