VBA Code - Search numbers and text

[SaraO]

Hi,

I have created a userform from an online tutorial. I got it working but when I search for a number it can't seem to find it. With text it has no problem. I am using it to search SKU #, some are just numbers and some have a combination of numbers and letter.

This is the code. How can it be modified to search for numbers, text or a combination of numbers and text?

Private Sub cmdContact_Click()
'dim the variables 
Dim Crit As Range 
Dim FindMe As Range 
Dim DataSH As Worksheet 
'error handler 
On Error GoTo errHandler: 
'set object variables 
Set DataSH = Sheet1 
'hold in memory and stop screen flicker 
Application.ScreenUpdating = False 

If Me.cboHeader.Value <> "All_Columns" Then 
If Me.txtSearch = "" Then 
DataSH.Range("L9") = "" 
Else 
DataSH.Range("L9") = "*" & Me.txtSearch.Value & "*" 
End If 
End If 

'if all columns is selected 
If Me.cboHeader.Value = "All_Columns" Then 
'find the value in the column 
Set FindMe = DataSH.Range("B9:I30000").Find(What:=txtSearch, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) 
'variable for criteria header 
Set Crit = DataSH.Cells(8, FindMe.Column) 
'if no criteria is added to the search 
If Me.txtSearch = "" 
Then DataSH.Range("L9") = "" 
DataSH.Range("L8") = ""
 Else 
'add values from the search 
DataSH.Range("L8") = Crit 
If Crit = "ID" Then 
DataSH.Range("L9") = Me.txtSearch.Value Else DataSH.Range("L9") = "*" & Me.txtSearch.Value & "*" 
End If 
'show in the userform the header that is added 
Me.txtAllColumn = DataSH.Range("L8").Value 
End If 
End If 

'filter the data 
DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("Data!$L$8:$L$9"), CopyToRange:=Range("Data!$N$8:$U$8"), _ Unique:=False 
'add the dynamic data to the listbox 
lstEmployee.RowSource = DataSH.Range("outdata").Address(external:=True) 

'error handler 
On Error GoTo 0 Exit SuberrHandler: 
 
'if error occurs then show me exactly where the error occurs 
MsgBox "No match found for " & txtSearch.Text 
'clear the listbox if no match is found 
Me.lstEmployee.RowSource = "" 
Exit Sub
End Sub

 

[DanteAmor]

Use this:

I created a routine to verify if the numerical data, then look for a column with numbers. And based on that column puts the data in the advanced filter.

[COLOR=#0000ff]Private Sub cmdContact_Click()[/COLOR]
  Dim Crit As Range, FindMe As Range, DataSH As Worksheet, lr As Long, j As Long, h As Range
  'set object variables
  Set DataSH = Sheet1
  'hold in memory and stop screen flicker
  lr = DataSH.Range("B" & Rows.Count).End(xlUp).Row
  j = 9
  DataSH.Range("L9:L" & Rows.Count).ClearContents
  Application.ScreenUpdating = False
  Me.txtSearch = Me.txtSearch
  If Me.cboHeader.Value <> "All_Columns" Then
    DataSH.Range("L8") = cboHeader
    If Me.txtSearch = "" Then
      DataSH.Range("L9") = ""
    Else
      If IsNumeric(Me.txtSearch) Then
        Set h = DataSH.Range("B8:I8").Find(cboHeader, , xlValues, xlWhole)
        If Not h Is Nothing Then
          Call Put_Numbers(DataSH, lr, j, h.Column)
        Else
          MsgBox "Header not valid"
          Me.lstEmployee.RowSource = ""
          Exit Sub
        End If
      Else
        DataSH.Range("L9") = "*" & Me.txtSearch & "*"
      End If
    End If
  Else
    'if all columns is selected
    'find the value in the column
    Set FindMe = DataSH.Range("B9:I" & lr).Find(Me.txtSearch, , xlValues, xlPart)
    If Not FindMe Is Nothing Then
      'variable for criteria header
      Set Crit = DataSH.Cells(8, FindMe.Column)
      'if no criteria is added to the search
      If Me.txtSearch = "" Then
        DataSH.Range("L9") = ""
        DataSH.Range("L8") = ""
      Else
        'add values from the search
        DataSH.Range("L8") = Crit
        If Crit = "ID" Then
          DataSH.Range("L9") = Me.txtSearch
        Else
          If IsNumeric(FindMe.Value) Then
            Call Put_Numbers(DataSH, lr, j, FindMe.Column)
          Else
            DataSH.Range("L9") = "*" & Me.txtSearch & "*"
          End If
        End If
        'show in the userform the header that is added
      End If
    Else
      MsgBox "No match found for " & txtSearch.Text
      Me.lstEmployee.RowSource = ""
      Exit Sub
    End If
  End If
  'filter the data
  Me.txtAllColumn = DataSH.Range("L8").Value
  j = DataSH.Range("L" & Rows.Count).End(xlUp).Row
  DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("Data!L8:L" & j), CopyToRange:=Range("Data!N8:U8"), Unique:=False
  'add the dynamic data to the listbox
  lstEmployee.RowSource = DataSH.Range("outdata").Address(external:=True)
End Sub


[COLOR=#0000ff]Sub Put_Numbers(DataSH, lr, j, col)[/COLOR]
  Dim r As Range, f As Range, cell As String
  Set r = DataSH.Range(DataSH.Cells(8, col), DataSH.Cells(lr, col))
  Set f = r.Find(Me.txtSearch, , xlValues, xlPart)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      DataSH.Range("L" & j) = f.Value
      j = j + 1
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
End Sub

Try and tell me.

 

[dmt32]

Hi,
I tried your code & seemed to work ok for me when searching numeric values

Just out of curiosity, you could try changing the xlLookin parameter from xlValues to xlFormulas & see if this makes any difference.

 Set FindMe = DataSH.Range("B9:I30000").Find(What:=txtSearch, LookIn:=xlFormulas, _        
                                             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                              MatchCase:=False, SearchFormat:=False)

Dave

 

[DanteAmor]

I tried your code & seemed to work ok for me when searching numeric values

 Set FindMe

Hi @dmt32

The problem is not with the Find method, the problem is with the advanced filter.
With text the advanced filter can have *abc* and it works.
But with numerical values ​​setting *123* does not work.

 

[SaraO]

Works like a charm.

Thank you so much!

 

[DanteAmor]

Works like a charm.

Thank you so much!

I'm glad to help you. Thanks for the feedback.