Filter Sheet With Text

[adamsm]

Hi,

I'm using the following code to filter the sheet when the search text is written above the column headings.

My headings are on row 10. And my data starts from column C11:to K11 onwards.

But when I write the search text above the column headers the worksheet does not get filtered with the text written in the cell above the column header.

I would be happy if anyone could let me know how to overcome this.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As String

'Set this next value to the row number above your filter
Const testrow = 8
'Change the marker to something other than the caret ^ if required
marker = "^"

   On Error GoTo Worksheet_Change_Error

rownum = Target.Row
colnum = Target.Column
On Error Resume Next

If Target.Count > 1 Then
    ActiveSheet.ShowAllData
    Target.Interior.ColorIndex = -4142 'clear colour from range
    GoTo cleanup
End If

If rownum <> testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)

If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1), marker, "")
optype = xlAnd
End If

If caret2 Then
optype = xlOr
End If

If Val(Application.Version) < 11 Then GoTo earlyversion

     Set mylist = ActiveSheet.ListObjects
     If mylist.Count Then ' A List or Table Object is used
            tblname = mylist(1).Name
        
        If Cells(rownum, colnum).Value = "" Then ' No filter choice
             mylist(tblname).Range.AutoFilter Field:=colnum
             GoTo cleanup
        ElseIf caret Then
            mylist(tblname).Range.AutoFilter Field:=colnum, _
            Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
            GoTo cleanup
        Else
            mylist(tblname).Range.AutoFilter Field:=colnum, _
            Criteria1:=crit1
            GoTo cleanup
    End If
    
    ' There is no List object, it is a Range so treat the same as
    ' earlier versions of Excel
    
End If

earlyversion:
'This version of Excel does not support List Objects
    If Cells(rownum, colnum).Value = "" Then
        Selection.AutoFilter Field:=colnum
    ElseIf caret Then
        Selection.AutoFilter Field:=colnum, _
        Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
    Else
    Selection.AutoFilter Field:=colnum, Criteria1:=crit1
    End If

cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell <> "" Then
    ActiveCell.Interior.ColorIndex = 40 'change to colour of your choice
Else
    ActiveCell.Interior.ColorIndex = -4142
    End If


   On Error GoTo 0
   Exit Sub

Worksheet_Change_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Sheet4"
    ActiveCell.Interior.ColorIndex = -4142
    On Error GoTo 0
End Sub