• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

vba Filter as you Type- data range

Nicki

Member
Hi Guys. Could you please look at the code for filtering. by typing Emma in the box I 'd like to see all the Rows are including Emma, I can see two instead of five Emma in data table. file attached. here is the code:

Screen Shot 2018-12-20 at 13.32.42.png
Code:
Private Sub TextBox1_Change()
Dim c, col As Long
With ActiveSheet.ListObjects("ContactList")
    .AutoFilter.ShowAllData
    With ActiveSheet.ListObjects("ContactList").DataBodyRange
        Set c = .Find([E4].Value, .Cells(1), xlValues, xlWhole, xlColumns)
        If Not c Is Nothing Then
            Debug.Print [E4]
            col = c.Column - 2
        ElseIf Len([E4].Value) = 0 Then
            Call clearFilter
            Exit Sub
        Else
            Exit Sub
        End If
      End With
    .Range.AutoFilter Field:=col, Criteria1:="*" & [E4] & "*", Operator:=xlFilterValues
End With
End Sub

Sub clearFilter()
    [E4] = ""
    ActiveSheet.ListObjects("ContactList").AutoFilter.ShowAllData
End Sub
 

Attachments

Last edited by a moderator:

NoSparks

New Member
The five Emma are spread over 3 columns.
You can use Advanced Filter.
Have added another sheet which holds the criteria range.
You really shouldn't have blank records in your table.
Code:
Private Sub TextBox1_Change()
  Dim crit As String, critRng As Range
If Len(TextBox1.Text) = 0 Then
  'required to show blank records
  crit = ""
Else
  'what to filter for
  crit = "*" & TextBox1.Text & "*"
End If
'populate the criteria range
Set critRng = Sheets("Sheet2").Range("A1:C4")
With Sheets("Sheet2").Cells(2, 1)
  .Value = crit
  .Offset(1, 1).Value = crit
  .Offset(2, 2).Value = crit
End With
'do the filtering in place
With ActiveSheet.ListObjects("ContactList").Range
  .AdvancedFilter xlFilterInPlace, critRng
End With
End Sub


Sub clearFilter()
  TextBox1.Value = ""
End Sub
 

Attachments

Nicki

Member
The five Emma are spread over 3 columns.
You can use Advanced Filter.
Have added another sheet which holds the criteria range.
You really shouldn't have blank records in your table.
Code:
Private Sub TextBox1_Change()
  Dim crit As String, critRng As Range
If Len(TextBox1.Text) = 0 Then
  'required to show blank records
  crit = ""
Else
  'what to filter for
  crit = "*" & TextBox1.Text & "*"
End If
'populate the criteria range
Set critRng = Sheets("Sheet2").Range("A1:C4")
With Sheets("Sheet2").Cells(2, 1)
  .Value = crit
  .Offset(1, 1).Value = crit
  .Offset(2, 2).Value = crit
End With
'do the filtering in place
With ActiveSheet.ListObjects("ContactList").Range
  .AdvancedFilter xlFilterInPlace, critRng
End With
End Sub


Sub clearFilter()
  TextBox1.Value = ""
End Sub
Thanks NoSparks. This is great.
 

Nicki

Member
Thanks NoSparks. This is great.
The five Emma are spread over 3 columns.
You can use Advanced Filter.
Have added another sheet which holds the criteria range.
You really shouldn't have blank records in your table.
Code:
Private Sub TextBox1_Change()
  Dim crit As String, critRng As Range
If Len(TextBox1.Text) = 0 Then
  'required to show blank records
  crit = ""
Else
  'what to filter for
  crit = "*" & TextBox1.Text & "*"
End If
'populate the criteria range
Set critRng = Sheets("Sheet2").Range("A1:C4")
With Sheets("Sheet2").Cells(2, 1)
  .Value = crit
  .Offset(1, 1).Value = crit
  .Offset(2, 2).Value = crit
End With
'do the filtering in place
With ActiveSheet.ListObjects("ContactList").Range
  .AdvancedFilter xlFilterInPlace, critRng
End With
End Sub


Sub clearFilter()
  TextBox1.Value = ""
End Sub
If i type an initial or Emma in column N, nothing will show up, how can i etend the range that covers the A:K in sheet 2
Thanks
 

Nicki

Member
The five Emma are spread over 3 columns.
You can use Advanced Filter.
Have added another sheet which holds the criteria range.
You really shouldn't have blank records in your table.
Code:
Private Sub TextBox1_Change()
  Dim crit As String, critRng As Range
If Len(TextBox1.Text) = 0 Then
  'required to show blank records
  crit = ""
Else
  'what to filter for
  crit = "*" & TextBox1.Text & "*"
End If
'populate the criteria range
Set critRng = Sheets("Sheet2").Range("A1:C4")
With Sheets("Sheet2").Cells(2, 1)
  .Value = crit
  .Offset(1, 1).Value = crit
  .Offset(2, 2).Value = crit
End With
'do the filtering in place
With ActiveSheet.ListObjects("ContactList").Range
  .AdvancedFilter xlFilterInPlace, critRng
End With
End Sub


Sub clearFilter()
  TextBox1.Value = ""
End Sub
Could you add a criteria for whatever you type in C4, highlight the finding in Red. i.e if i Type Emma All to be shown in red in ContactList Table.
Thanks
 
Top