I've developed the following code to compare two cells (strings) in columns A and D and write down the D cell value in the corresponding B cell if a partial match is found.
Sub CompareAndGuess()
Dim strLen, aux As Integer
Dim max1, max2 As Long
Dim str As String
Range("A1").Select
Selection.End(xlDown).Select
max1 = ActiveCell.Row
Range("D1").Select
Selection.End(xlDown).Select
max2 = ActiveCell.Row
For a = 2 To max1
str = Cells(a, 1)
str = StrConv(str, vbUpperCase)
strLen = Len(str)
aux = strLen
For l = 3 To strLen
For d = 2 To max2
If Cells(d, 4) = Left(str, aux) Then
Cells(a, 2) = Cells(d, 4)
Exit For
ElseIf Cells(d, 4) = Right(str, aux) Then
Cells(a, 2) = Cells(d, 4)
Exit For
End If
Next d
aux = aux - 1
If Cells(a, 2) <> "" Then
Exit For
End If
Next l
Cells(a, 2).Select
Next a
End Sub
Can anyone help me find where is the problem because when I run it the code only guesses right one row out of 50 whereas it should match at least 40 or so.
Please, I really can't find the error in there. Feel free to propose another solution to my problem if you want.
A sample of the data I'm analysing is: Names with Typos:-
Jatiuca
Pajuara
Poco
Santa Luzia
Pajucara
Domingos Acacio
Jaragua
Stella Maris
P Verde
Tabuleiro dos Martin
Gruta Lourdes
Brasilia
Centro Historico
Monumento
Tabuleiro dos Martins
Names with Typos to be searched on this list:-
JARAGUÁ
TABULEIRO DO MARTINS
CENTRO
BRASÍLIA
CACIMBAS
JATIÚCA
CAITITUS
PAJUÇARA
CANAÃ
PONTA VERDE
CANAFÍSTULA
POÇO
CAPIATÃ
CAVACO
SANTA LÚCIA
I've found the right way to do it with everyone's help. Here it is:
If InStr(1, Cells(d, 4), Left(str, aux)) = 1 Then
Cells(a, 2) = Cells(d, 4)
Exit For
ElseIf InStr(Cells(d, 4), Right(str, aux)) + strLen - aux = strLen Then
Cells(a, 2) = Cells(d, 4)
Exit For
End If
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With