VBA partial match between two column-CodePudding

I have a workbook with two sheets, "RO" and "LookUp"

In column K on Sheet "RO" there is a list of addresses and in Column E of "LookUp" there is a list of towns.

On Sheet "RO" column Q i am trying to extract the town name that matches a town on the list in the "lookUp" sheet.

I've tried variations of partial Vlookup and index and match functions but they obviously haven't worked because they are backwards (looking up the full address in the towns list rather than the other way around)

=VLOOKUP("*"&J2&"",'Look up Data'!E:E,1,0)

I tried doing an if statement using like (i knew it wouldnt work but it might give an idea of what i am trying do) see below.

Sub ROITown()

    Dim lRow As Long
    Dim iCntr As Long
    Set ws = Worksheets("RO")
    Set ls = Worksheets("LookUp")
    lRow = ws.Cells(Rows.Count, 5).End(xlUp).Row
    For iCntr = lRow To 2 Step -1
        If ws.Cells(iCntr, 10).Value Like ls.Cells(iCntr, 5).Value Then
            ws.Cells(iCntr, 17).Value = ls.Cells(iCntr, 5).Value
        End If
    Next iCntr
End Sub

these are some examples of my expected output

Column K "RO"
THE MEADOW AVENUE DEMESNE NAAS
BELFRY PARK DUNDALK CO. LOUTH
KESTREL PUB CO. LOUTH
AVONDALE CREST DUNBOYNE CO. MEATH
KNIGHTSBROOK STREET TRIM CO. MEATH
TAYLOR GREEN AVENUE BALBRIGGAN CO. DUBLIN

Column E "LookUp"
Athy
Balbriggan
Baldoyle
Citywest
Clane
Drogheda
Dun Laoghaire
Dunboyne
Dundalk
Dungarvan
Monasterevin
Mullingar
Naas
Navan
Tramore
Trim
Tuam

Expected Results in Column Q "RO"
Naas
Dundalk

Dunboyne
Trim
Balbriggan

As you can see, for the solution I need it to not be case sensitive and also where it doesnt find a matching town in the list it should just leave the cell blank.

Any advice even basic is welcome, even just point me in the right direction or let me know what I should search to find a solution.

Thanks in advance :)

CodePudding user response：

You need 2 nested loops to iterate the sheets independently.

Option Explicit

Sub ROITown()

    Dim s As String, arTown, LastRow As Long
    Dim r As Long, i As Long, n As Long
    
    With Worksheets("LookUp") ' towns
         LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
         arTown = .Range("E2:E" & LastRow)
    End With
    
    With Worksheets("RO") ' address
        LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
        For r = 2 To LastRow
            For i = 1 To UBound(arTown)
                s = Trim(arTown(i, 1))
                If InStr(1, .Cells(r, "K"), s, vbTextCompare) Then
                    .Cells(r, "Q") = s
                    n = n   1
                    Exit For
                End If
            Next
        Next r
    End With
    MsgBox n & " rows updated", vbInformation
    
End Sub

CodePudding user response：

You can do this with a formula.

I Name'd the tables and am using structured references, but you can change that to regular addressing if you prefer:

This formula should work in any version at least since 2010

=IFERROR(INDEX(Lookup,AGGREGATE(15,6,1/(ISNUMBER(SEARCH(Lookup[Lookup],TRANSPOSE(LongName[Towns]))))*ROW(Lookup)-ROW(Lookup[#Headers]),ROW(INDEX($A:$A,1):INDEX($A:$A,ROWS(Lookup))))),"")

CodePudding user response：

Have you tried using an INSTR instead of the LIKE?

As in:

If InStr(1,ws.Cells(iCntr, 10),ls.Cells(iCntr, 5)) > 0 Then

This will check and compare the strings, the > 0 denotes where it found the string