A nice filtering template.
The value in textbox is searched as part or whole in the column. The results found are shown in the column, the other data are hidden.
Search and filtering are performed when button is clicked. The codes :
Private Sub CommandButton2_Click()
Dim aCell As Range, bCell As Range
Dim SearchString As String, son As Long
Dim RngOne As Range, cell As Range
On Error GoTo Whoa
If TextBox3.Value = Empty Then
MsgBox "Please, Enter A Value To Textbox", vbCritical, ""
Exit Sub
End If
ActiveSheet.Range("A3:K3").AutoFilter
Range("AN:AN").Clear
Sheets("Data").Cells.EntireRow.Hidden = False
SearchString = TextBox3.Value
Range("F:F").Activate
Select Case TextBox3.Value
Case "?"
TextBox3.Value = "~?"
Case "*"
TextBox3.Value = "~*"
Case "%"
GoTo bura_a
Case "="
GoTo bura_a
Case IsNumeric(TextBox3)
GoTo bura_a
End Select
If OptionButton1.Value = True And Not IsNumeric(TextBox3.Value) Then
GoTo bura1
ElseIf OptionButton2.Value = True And Not IsNumeric(TextBox3.Value) Then
GoTo bura2
End If
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
bura_a:
If OptionButton1.Value = True Then
ActiveSheet.Range("A3:K3").AutoFilter
Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).Find(what:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart)
ElseIf OptionButton2.Value = True Then
ActiveSheet.Range("A3:K3").AutoFilter
Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).Find(what:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole)
End If
Application.Goto Sheets("Data").Range("A4"), Scroll:=True
Application.ScreenUpdating = True
Label1.Visible = True
Application.ScreenUpdating = False
Sheets("Data").Cells.EntireRow.Hidden = False
If Not aCell Is Nothing Then
Set bCell = aCell
Range("AN2").Value = aCell.Address(False, False)
Do
son = 0
Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
son = son + 1
Range("AN" & Rows.Count).End(xlUp).Offset(son, 0).Value = aCell.Address(False, False)
Else
Exit Do
End If
Loop
Label1.Visible = False
Else
Label1.Visible = False
Range("G2").Activate
MsgBox SearchString & " Not Found", vbCritical, ""
Exit Sub
End If
With Sheets("Data")
Set RngOne = .Range("AN2:AN" & .Range("AN" & Sheets("Data").Rows.Count).End(xlUp).Row)
End With
Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = True
For Each cell In RngOne
Range(cell).EntireRow.Hidden = False
Next cell
MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Set aCell = Nothing
Exit Sub
bura1:
Application.Goto Sheets("Data").Range("A4"), Scroll:=True
Label1.Visible = True
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A3:K3").AutoFilter
Label1.Visible = False
Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).AutoFilter field:=6, Criteria1:="*" & TextBox3.Value & "*"
If AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
ActiveSheet.ShowAllData
Range("G2").Activate
MsgBox SearchString & " Not Found", vbCritical, ""
Else
MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
End If
Exit Sub
bura2:
Application.Goto Sheets("Data").Range("A4"), Scroll:=True
Label1.Visible = True
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A3:K3").AutoFilter
Label1.Visible = False
Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).AutoFilter field:=6, Criteria1:=TextBox3.Value
If AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
ActiveSheet.ShowAllData
Range("G2").Activate
MsgBox SearchString & " Not Found", vbCritical, ""
Else
MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
End If
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
