excelvbasearchexcel-formulavlookup

How to get partial match result between range of cells and a column of values


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 :)


Solution

  • 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