Match 2 columns of data based on common substring, with a fallback, using VBA? - excel

Question

I have 2 columns of data: Item numbers and the image name for them (A and C):
Updated sample data:
If an image filename matches the item number, I want to match them in column B (empty) otherwise fall back to a default (if available).
Example: Iterate through column A & C, if image matches the item number, match, otherwise fall back to default. In my case, default would end with either -5.jpg, -4.jpg, 4-ROOM.jpg or 5-ROOM.jpg.
So the desired result (in column B above) would be everything except for LRL0547A-24.jpg would be matched with LRL0547-4-ROOM.jpg (because it's one of the fallbacks).
My code I've tried is here (I need another pair of eyeballs, mine are hurting):
Public Sub test()
Dim ws As Worksheet, arr(), r As Long, c As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
On Error Resume Next
For r = LBound(arr, 1) To UBound(arr, 1)
For c = LBound(arr, 1) To UBound(arr, 1)
Select Case True
Case Right$(arr(c, 3), 9) = "4-ROOM.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 9) = arr(r, 1)
arr(r, 2) = arr(c, 3)
Exit For
Case Right$(arr(c, 3), 6) = "5-ROOM.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 6) = arr(r, 1)
arr(r, 2) = arr(c, 3)
Exit For
Case Right$(arr(c, 3), 6) = "-5.jpg" And Left$(arr(c, 3), Len(arr(c, 3)) - 6) = arr(r, 1)
arr(r, 2) = arr(c, 3)
Exit For
End Select
Next
Next
On Error GoTo 0
ws.Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

Answer 1

Your inner loop needs to keep checking for an exact match, even if you already found a fallback.
Untested:
Public Sub test()
Dim ws As Worksheet, arrSku, arrImg, r As Long, c As Long, itm, img, p As Long
Dim rngSku As Range, rngImg As Range
Dim exactMatch, fallBack, pm
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rngSku = ws.Range("A2:B" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set rngImg = ws.Range("C2:D" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
arrSku = rngSku.Value 'each array has two "columns"
arrImg = rngImg.Value
For r = 1 To UBound(arrImg, 1) 'loop the images and remove any extension
img = Trim(arrImg(r, 1))
p = InStrRev(img, ".")
If p > 0 Then img = Left(img, p - 1)
arrImg(r, 2) = img 'caching the name with no extension back in the array
Next r
For r = 1 To UBound(arrSku, 1)
itm = Trim(arrSku(r, 1))
exactMatch = "" 'clear any previous matches
fallBack = ""
For c = 1 To UBound(arrImg, 1)
img = arrImg(c, 2) 'checking against no-extension value
If img = itm Then
exactMatch = arrImg(c, 1) 'with extension
Exit For 'no need to check further
Else
For Each pm In Array("4-ROOM", "5-ROOM", "-5")
If itm & pm = img Then
fallBack = arrImg(c, 1)
Exit For 'stop checking for fallbacks, but keep checking for exact match...
End If
Next pm
End If
Next
'did we make any kind of match?
If Len(exactMatch) > 0 Then
arrSku(r, 2) = exactMatch
ElseIf Len(fallBack) > 0 Then
arrSku(r, 2) = fallBack
Else
arrSku(r, 2) = ""
End If
Next
rngSku.Value = arrSku 'put back data into A:B
End Sub
If this doesn't do what you want then please post some sample data in text format so I can test.