Manage multivalued attributes

I know you have a solution, but, just for fun, another option:

' Module: mOneToMany

'Option Private Module
Option Explicit

Sub sOneToMany()

Dim lLR As Long, lNR As Long
Dim i As Long, j As Long
Dim vx1, vy2, vRequest
Const sInput As String = "Sheet1"
Const sOutput As String = "Sheet2"

Dim sw As New StopWatch
sw.StartTimer
Debug.Print "Start: ", Time
    
Application.ScreenUpdating = False
Sheets(sOutput).Cells.Delete

With Sheets(sInput)
    lLR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:B1").Copy _
        Sheets(sOutput).Range("A1")
End With

For i = 2 To lLR
    With Sheets(sInput)
        vRequest = .Range("A" & i)
        If .Range("B" & i) = "" Then GoTo lblSkip
        vx1 = Split(.Range("B" & i), ",")
        ReDim vy2(LBound(vx1) To UBound(vx1), 1 To 2)
        For j = LBound(vx1) To UBound(vx1)
            vy2(j, 1) = vRequest: vy2(j, 2) = vx1(j)
        Next 'j
    End With
    With Sheets(sOutput)
        lNR = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        .Range("A" & lNR).Resize(UBound(vx1) + 1, 2).Value = vy2
    End With
lblSkip:
Next 'i

Sheets(sOutput).Range("A1:B1").EntireColumn.AutoFit
Application.ScreenUpdating = True

Debug.Print "End: ", Time
Debug.Print "sOneToMany took: " & sw.EndTimer & " milliseconds."

End Sub

Some differences to note:
1. John's code operates on the Active Sheet and overwrites it
2. My code writes the output to a new sheet which must pre-exist (in this case, Sheet2)
3. I've added a timer routine so you can compare times. Bit of a movable feast depending on the foibles of the machine.
Sometimes one is faster, then the other ... but not a lot in it
4. The timer will not work in 64 bit installations of Excel


Regards, TMS