Crossmatching Names All Possible Match VBA

[austinandreikurt]

Hi,
Is there a vba code where it can replicate the google search or facebook search function that can list all possible results including misspellings? Say I have all the names in Column A, then my search value is in D1, then all possible results will be listed down in Column F. Below is my example.

Book1
	A	B	C	D	E	F
1	Names		SEARCH	RoseAnn Domingo		RoseAnn Domingo
2	RoseAnn Domingo					Rose Ann Domingo
3	Juan Dela Vega					Rose Domingo
4	Rose Ann Domingo					Rose Anne Domingo
5	Rose Domingo					Rose Ann Domngo
6	Rose Anne Domingo
7	Tina Jacob
8	Rose Ann Domngo
9	Chris White
10	Alex Domingo
11	Rose Peñaflor
12
Sheet1

 

[Ezguy4u]

austin let's get the ball rolling. Now this usually gets more questions than answers, but we have to start some place. The requirement for this program is the first 4 letters of the name have to be the same. Let us know if this doesn't work for you.

Sub Prog1()

Dim LastRow As Integer
Dim Nam As String
Dim Row1 As Integer

Row1 = 1

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    Nam = Left(Cells(i, 1), 4)
If Left(Cells(i, 1), 4) Like Left(Cells(1, 4), 4) Then
    Cells(Row1, 6) = Cells(i, 1)
    Row1 = Row1 + 1
End If

Next i

End Sub

 

[austinandreikurt]

Hi @Ezguy4u thank you for attending my query. Is it possible to also consider the last name? Also, there are instances when lastname, first name format in a column just like below. The green ones are the one that should be captured by the codes:

Book1
	A	B	C	D	E	F
1	Names		SEARCH	Alexandre Reyes		Alexandre Mark Reyes
2	Alexandre Mark Reyes					Alex Reyes
3	Alex Reyes					Alexndre Reyes
4	Alexndre Reyes					Reyes, Alexandre
5	Rose Domingo
6	Rose Anne Domingo
7	Tina Jacob
8	Rose Ann Domngo
9	Chris White
10	Alex Domingo
11	Rose Peñaflor
12	Rse Domingo
13	Reyes, Alexandre
Sheet1

 

[Ezguy4u]

austin Coming up with a solution to excel questions is always a challenge. The different requirements, as we think of them, just means we keep working at it. Now I came up with a new input data requirement. As you can see if we can separate the name it will help with the output. So if you have any more requirements just let us know.

Sub Prog2()

Dim LastRow As Integer
Dim Nam As String
Dim Nam2 As String
Dim Row1 As Integer

Row1 = 1

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Nam = Left(Cells(2, 4), 4)
 Nam2 = Left(Cells(2, 6), 4)
  
For i = 2 To LastRow
 
If Nam Like Left(Cells(i, 1), 4) Then
    Cells(Row1, 8) = Cells(i, 1)
    Row1 = Row1 + 1
ElseIf Nam2 Like Left(Cells(i, 1), 4) Then
    Cells(Row1, 8) = Cells(i, 1)
    Row1 = Row1 + 1
End If

Next i

End Sub

 

[austinandreikurt]

Hi @Ezguy4u sorry I only replied now as I got sick. Many thanks for attending this problem and almost there! It still captures the "Alex Domingo" where "Domingo" is too far from the Key Last Name "Reyes".

 

[Ezguy4u]

austin, I love this. Coming up with a solution to an excel problem is so much fun. Now what we have here is a leaky boat. I keep patching up the holes as they appear. But I can imagine a couple more holes appearing in the future maybe. If you watch how the input data is entered and correct the data before they spring a leak, no problem. But if you think of something else and really want to come up with a fix, let us know.

Sub Prog2()

Dim LastRow As Integer
Dim NamCnt1 As Integer
Dim NamCnt2 As Integer
Dim NamCnt3 As Integer
Dim NamCnt4 As Integer
Dim NamCnt5 As Integer
Dim Nam1 As String
Dim Nam2 As String
Dim Row1 As Integer

Row1 = 1

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

NamCnt1 = Len(Cells(2, 4)) 'First Name
NamCnt2 = Len(Cells(2, 6))  'Last Name
 
For i = 2 To LastRow

NamCnt3 = Len(Cells(i, 1)) 'how many characters in cell
NamCnt4 = (NamCnt3 - NamCnt2) + 1 'This works for the first name first
Nam1 = Mid(Cells(i, 1), NamCnt4, NamCnt2)

NamCnt5 = NamCnt3 - NamCnt1
Nam2 = Mid(Cells(i, 1), NamCnt2 + 3, NamCnt1)
   
If Left(Cells(2, 4), 4) Like Left(Cells(i, 1), 4) And Left(Cells(2, 6), 4) Like Left(Nam1, 4) Then
    Cells(Row1, 8) = Cells(i, 1)
    Row1 = Row1 + 1
ElseIf Left(Cells(2, 6), 4) Like Left(Cells(i, 1), 4) And Left(Cells(2, 4), 4) Like Left(Nam2, 4) Then
    Cells(Row1, 8) = Cells(i, 1)
    Row1 = Row1 + 1
End If

Next i

End Sub

Names			First Name	Middle Name	Last Name		Alexandre Mark Reyes
Alexandre Mark Reyes		SEARCH	Alexandre		Reyes		Alex Reyes
Alex Reyes							Alexndre Reyes
Alexndre Reyes							Reyes, Alexandre
Rose Domingo							Reyes, Alexandre
Rose Anne Domingo
Reyes, Alexandre
Rose Ann Domngo
Chris White
Alex Domingo
Rose Peñaflor
Rse Domingo
Reyes, Alexandre