How to create a VBA script that creates new row, if more than one match is found?

Question

To clarify, say we have data like this (except column sku & image are several 1000 in length):

Matching A2 to B2 is easy, but not so much when uploading with Shopify. To indicate you're uploading an additional image, you must create a new row, and I'm hoping VBA can automate this part of the process. So the ideal outcome would look like:

So in addition to looping over sku column to find matches in image column, once a match is found, VBA would insert a new row and insert the value into that cell, under product_image column. I am VERY green to VBA, and find the syntax super hard to get used to, so if someone can provide help I should be able to do the rest. Thank you!

Here is my measly effort, hodgepodge of others code put together, but this only finds matches. Not inserting the new row part.

Sub FillImageNames()
Dim ws As Worksheet, imageArr()
Set ws = ThisWorkbook.Worksheets("Sheet1")

imageArr = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).row)

' (1) Fill Dictionary
Dim d As New Dictionary
Dim row As Long
For row = 1 To UBound(imageArr, 1)
    Dim filename As String, sku As Long
    filename = Trim(imageArr(row, 1))
    If filename <> "" Then
        sku = getSKUFromFilename(filename)
        d(sku) = filename
    End If
Next

' (2) Fill sheet
Dim lastRow as Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
For row = 2 To lastRow
    sku = Val(ws.Cells(row, 1))
    If d.Exists(sku) Then
        ws.Cells(row + 1, 2) = d(sku)
    End If
Next
End Sub

Answer 1

• Using Dictionary to consolidate images by SKU

Option Explicit

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String, j As Long, iR As Long
    Dim arrData, arrRes(), aImg
    Set objDic = CreateObject("scripting.dictionary")
    'Load data
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData), 1 To 2)
    ' Consolidate image by SKU
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = Split(Replace(arrData(i, 3), ".", "_"), "_")(0)
        If objDic.exists(sKey) Then
            objDic(sKey) = objDic(sKey) & "," & arrData(i, 3)
        Else
            objDic(sKey) = arrData(i, 3)
        End If
    Next i
    iR = 0
    ' Loop through SKU
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = Replace(arrData(i, 1), " ", "")
        If objDic.exists(sKey) Then
            aImg = Split(objDic(sKey), ",")
            For j = 0 To UBound(aImg)
                iR = iR + 1
                If j = 0 Then arrRes(iR, 1) = arrData(i, 1)
                arrRes(iR, 2) = aImg(j)
            Next
        End If
    Next i
    ' Update table
    Range("A2").Resize(iR, 2).Value = arrRes
End Sub

Microsoft documentation:

Dictionary object

Range.CurrentRegion property (Excel)

---

Update:

Question: alter script to include for cases where the sku is contained in the image name and matches same way

Option Explicit

Sub Demo2()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String, j As Long, iR As Long
    Dim arrData, arrRes(), aImg, sSKU
    Set objDic = CreateObject("scripting.dictionary")
    'Load data
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData), 1 To 2)
    ' Init Dict with SKU ID
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = Replace(arrData(i, 1), " ", "")
        If Len(sKey) > 0 Then
            objDic(sKey) = ""
        End If
    Next
    ' Consolidate image by SKU
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 3)
        For Each sSKU In objDic.Keys
            If InStr(1, sKey, sSKU, vbTextCompare) > 0 Then
                objDic(sSKU) = objDic(sSKU) & "," & arrData(i, 3)
            End If
        Next
    Next i
    iR = 0
    ' Loop through SKU
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = Replace(arrData(i, 1), " ", "")
        aImg = Split(Mid(objDic(sKey), 2), ",")
        For j = 0 To UBound(aImg)
            iR = iR + 1
            If j = 0 Then arrRes(iR, 1) = arrData(i, 1)
            arrRes(iR, 2) = aImg(j)
        Next
    Next i
    ' Update table
    Range("A2").Resize(iR, 2).Value = arrRes
End Sub