Excel 2013>VBA>Match>Wildcard

Hello,

I'm working on some code to clean up userform manual entry data. I would like to compare the manually entered string to my list, and (in this test workbook) output the desired string.

This code is working as I expect, except if I venture too far from the string I'm matching.

How do I write the code to anticipate those extreme deviations (extra words before or after match string) and extreme misspellings? Is it possible?

Here's the code:

Code:

---

Private Sub CommandButton1_Click()
 
 Dim txtINPUT As Variant
 Dim txtOUTPUT As Variant
 Dim txtPRINT As Variant
 
 txtINPUT = Me.TextBox1.Text
 
 txtOUTPUT = Application.Match("*" & txtINPUT & "*", ThisWorkbook.Sheets("Sheet1").Range("A1:A30"), 0)
 
 txtPRINT = ThisWorkbook.Sheets("Sheet1").Cells(txtOUTPUT, 1).Value
 
 With Me.Label2
  .Caption = txtPRINT
 End With
 
End Sub

---

TextBox1.Text = abc
A14 = klmn abcdef sdfg thylll
A23 = xcd abcdef sd

below returns klmn abcdef sdfg thylll, which is the first match.

Code:

---

Sub test()
    'Label2.Caption = Sheets("Sheet1").Cells(Application.Match("*" & TextBox1.Text & "*", Sheets("Sheet1").Range("A1:A30"), 0), 1).Value
    MsgBox Sheets("Sheet1").Cells(Application.Match("*" & "abc" & "*", Sheets("Sheet1").Range("A1:A30"), 0), 1).Value
End Sub

---

so what do you mean by "extreme deviation"?

Regarding "extreme deviation," Suppose the string I want to record in my database is "Abunayyan" but the input is "A Abunayyan Trading Company"...how would I search my list of 30 companies and match to "Abunayyan" so that I can record that text in my database?

Suppose you reverse the strings in your example above...

TextBox1.Text = xcd abcdef sd

A23 = abc

This is the situation I'm trying to cleanup. I'd like to match the TextBox1 text to A23.

Thanks for your suggestions!

same way.
or am i missing something?


change abc to Abunayyan and klmn abcdef sdfg thylll to A Abunayyan Trading Company in the code i posted.

it will return A Abunayyan Trading Company from A14.

but if any cell above it, say A5, contains Abunayyan, for ex Abunayyan Home Appliances, this time it will return value from A5.

if you want A Abunayyan Trading Company get returned, you should change the search string to Abunayyan Trading, etc.

I'm sorry I didn't explain it clearly...

I start with the multiple string text "A Abunayyan Trading Company" and I want to return simply "Abunayyan."

you want to search "A Abunayyan Trading Company" in Sheet1/ColumnA to return "Abunayyan"?

maybe you should set up a table which will include possible search strings and their desired equivalents.
then use index/match or vlookup.

it is hard to code "search for A Abunayyan Trading Company and return Abunayyan."

there must be a rule, logic, reasoning, algorithm, whatever you say.

That's what I was thinking...VLOOKUP is what I've been using in another workbook for another task. The only problem I've encountered from time to time is that a new variation appears (due to manual entry). So, I have to add the new variation to the lookup table. I was hoping to create a more automated method.

Thank you very much for your help!

It can be rules based if you know the rules

I had done something that uses a manually maintained list of Deletes and Replaces to (sort of) normalize Company names.

When there was a new oddball, I had to add it to the list


Attachment 16740


This is a user defined function, but could be converted to a sub and it'd probably run faster

Code:

---

Option Explicit

Function CleanUp(S As String, Deletes As Range, Replaces As Range) As String
    Dim s1 As String, s2 As String, s3 As String, s4 As String
    Dim v As Variant
    Dim i As Long, iMatch As Long
    Dim r As Range
   
    'clean the input
    s1 = Application.WorksheetFunction.Clean(S)
    s1 = UCase(s1)
   
    For i = 1 To Len(s1)
        Select Case Mid(s1, i, 1)
            Case "0" To "9", "A" To "Z", " ", "-", "/"
                s2 = s2 & Mid(s1, i, 1)
        End Select
    Next i
   
    'split at spaces
    v = Split(s2, " ")
   
    'see is each piece is a DELETE
    For i = LBound(v) To UBound(v)
        v(i) = Trim(v(i))
        iMatch = -1
        On Error Resume Next
        iMatch = Application.WorksheetFunction.Match(v(i), Deletes.Columns(1), 0)
        On Error GoTo 0
       
        'if not -1 then found in DELETES column
        If iMatch > -1 Then v(i) = vbNullString
    Next
   
    'put back togeather
    s3 = Join(v, " ")
    s3 = Trim(s3)
   
    'check REPLACE THIS
    'split at spaces
    v = Split(s3, " ")
   
    'see is each piece is a REPLACE THIS
    For i = LBound(v) To UBound(v)
        v(i) = Trim(v(i))
        iMatch = -1
        On Error Resume Next
        iMatch = Application.WorksheetFunction.Match(v(i), Replaces.Columns(1), 0)
        On Error GoTo 0
       
        'if not -1 then found in REPLACE THIS column
        If iMatch > -1 Then v(i) = Replaces.Cells(iMatch, 2).Value
    Next
   
    'put back togeather
    s4 = Join(v, " ")
    s4 = Trim(s4)
       
    CleanUp = Application.WorksheetFunction.Proper(s4)
End Function

---