CODEWITHSUNDEEP
vbaexcel
ranopano
ranopano

Reputation: 539

VBA Code for search box that filters table

I've designed a search box that filters my table when text is entered into said search box. The problem is that it is soooo slow, it's almost not even worth having it in my workbook right now.

Can anyone think of any way to revise/improve upon this code?

Here is my code currently:

Private Sub TextBox1_Change()
 Dim searchArea As Range, searchRow As Range, searchCell As Range
 Dim searchString As String
 Dim lastRow As Integer

 Application.ScreenUpdating = False
 searchString = "*" & LCase(TextBox1.Value) & "*"
 Rows.Hidden = False

 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 Set searchArea = Me.Range("f3:f791", "f3" & lastRow)
 searchArea.EntireRow.Hidden = True

 For Each searchRow In searchArea.Rows
   For Each searchCell In searchRow.Cells
     If LCase(searchCell) Like searchString Then
       searchRow.Hidden = False
       Exit For
     End If
   Next searchCell
 Next searchRow

 Application.Goto Range("Z1"), True
 ActiveWindow.ScrollColumn = 1
 Application.ScreenUpdating = True

End Sub

Edited my code to this:

Private Sub TextBox1_Change()
    ActiveSheet.ListObjects("states").Range.AutoFilter Field:=1, _
        Criteria1:="*" & [G1] & "*", Operator:=xlFilterValues
End Sub

However, this is not working. There are text and numbers in Field 1, and this only is filtering text, not the numbers...

Upvotes: 0

Views: 2683

Answers (1)

David Zemens
David Zemens

Reputation: 53663

This is definitely redundantly redundant, because your iteration is over a single column:

 For Each searchRow In searchArea.Rows
   For Each searchCell In searchRow.Cells  '### searchRow ONLY HAS ONE CELL! This second/inner loop is totally unnecessary
     If LCase(searchCell) Like searchString Then
       searchRow.Hidden = False
       Exit For
     End If
   Next searchCell
 Next searchRow

Rewrite as:

For Each searchCell in searchArea.Cells '## Assumes searchArea is single column
   searchCell.EntireRow.Hidden = Not (LCase(searchCell) Like searchString)
Next

That alone should improve performance, but I think AutoFilter is a better method, and you should be able to derive the basic code for that from the Macro Recorder.

This would look something like:

searchArea.AutoFilter Field:=1, Criteria1:="=" & searchString, _
    Operator:=xlAnd, Criteria2:="<>"

This should filter to display only non-blank rows which contain your searchString

@Yowe3k's points about the range assigment should also be noted, and you may use the AfterUpdate event of the TextBox instead of the Change event.

UPDATE This might work to handle your mixed cases of numeric/text values. There might be a better way to do this but I don't see an obvious solution. The AutoFilter is meant to work with either text or numbers, but not both. So this attempts to convert numeric values to string representations. You may need to make changes elsewhere if the numeric values are referenced in formula, etc.

Dim arr, v
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(1)
' ## Disable filter if it's on already
If tbl.Range.AutoFilter Then tbl.Range.AutoFilter
arr = tbl.DataBodyRange.Columns(1).Value
' ## Convert your range of mixed numeric/string to string
For v = LBound(arr, 1) To UBound(arr, 1)
    If IsNumeric(arr(v, 1)) Then
        arr(v, 1) = "'" & CStr(arr(v, 1))
    End If
Next
' ## Put the string data back out to the worksheet
tbl.DataBodyRange.Columns(1).Value = arr
tbl.Range.AutoFilter Field:=1, _
       Criteria1:="*" & CStr([G1]) & "*", Operator:=xlFilterValues

Upvotes: 1

Related Questions