Transform Duplicate rows to columns

The following code performs the following:

From:
word1 ; word_a
word1 ; word_b
word2 ; word_c
word2 ; word_d
word2 ; word_e

To:
word1 ; word_a ; word_b
word2 ; word_c ; word_d ; word_e
word3 ; word_f

Sub x()

Dim rInput As Range, oDic As Object, sNames() As String, vInput()
Dim i As Long, nIndex As Long

Set rInput = Range("A1", Range("B65536").End(xlUp))
vInput = rInput.Value
ReDim sNames(1 To UBound(vInput, 1), 1 To 2)
Set oDic = CreateObject("Scripting.Dictionary")

With oDic
    For i = 1 To UBound(vInput, 1)
        If Not .Exists(vInput(i, 1)) Then
            nIndex = nIndex + 1
            sNames(nIndex, 1) = vInput(i, 1)
            sNames(nIndex, 2) = vInput(i, 2)
            .Add vInput(i, 1), nIndex
        ElseIf .Exists(vInput(i, 1)) Then
            sNames(.Item(vInput(i, 1)), 2) = sNames(.Item(vInput(i, 1)), 2) & ", " & vInput(i, 2)
        End If
    Next i
End With

Cells(1, "H").Resize(nIndex, 2) = sNames
' The line below if you want the words in separate columns
' otherwise they are in a single cell, separated by commas
Cells(1, "I").Resize(nIndex).TextToColumns , comma:=True

End Sub

However I want the ability to transpose two columns i.e. word_a and word_1

From:
word1 ; word_a, word_1
word1 ; word_b, word_2

To:

word1 ; word_a ; word_1;word_b;word_2

Can anyone help?