Matching similar but not exact text strings in Excel VBA projects

Question

Okay, I have been trying to find a solution for this and I just don't seem to be able. I can't even break down the problem properly. This is the idea.

I have two sheets with many rows (one with 800 and the other with 300,000). Each row contains a Name column and then several columns that contain information about this Name. Each sheet has different kinds of information.

I want to consolidate these two sheets into a master sheet based on this Name column they both have, so the consolidate function is perfect for this. Now the problem is that the names don't match perfectly.

For example Sheet1 contains

"Company B.V.", "Info #1"
"Company Total", "Info #2"
"Company Ltd", "Info #3"

and sheet 2 contains

"Company and Co.", "Info #4"
"Company and Co", "Info #5"

Sheet 1 contains all the names that are going to be used (around a 100 but in different forms as stated above) and sheet 2 contains all these 100 in multiple rows plus names that aren't in the 100 list and therefore I don't care about.

How would I make a VBA code project where the end result would be something like this, Master sheet:

"Company", "Info #1", "Info #2", "Info #3", "Info #4", "Info #5"

for every single "Company" (the 100 list) in there??

I do hope there is a solution for this. I'm pretty new to VBA projects, but I have done some minimal coding before.

Answer 1

I would place the macro in your PERSONAL section, this way the macro is available in all worksheets. Do this by recording a dummy macro and select to store it in Personal Macro workbook. Now you can manually add new macro's and functions in this personal workbook.

I just tried this one (don't know the original source) and it works fine.

The formula looks like this: =PERSONAL.XLSB!FuzzyFind(A1,B$1:B$20)

The code is here:

Function FuzzyFind(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
For Each cell In tbl_array
  str = cell
  For i = 1 To Len(lookup_value)
    If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
      a = a + 1
      cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid(cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
    End If
  Next i
  a = a - Len(cell)
  If a > b Then
    b = a
    Value = str
  End If
  a = 0
Next cell
FuzzyFind = Value
End Function