Skeleton of approach
Didn't do anything actually using Word, but you can see where you'd include your code
Option Explicit
Sub List2Word()
Dim rList As Range, rList1 As Range
Dim i As Long, j As Long
Dim sPretendWordDoc As String
Dim aryList As Variant, v As Variant
'sort inputs
With ActiveSheet
Set rList = .Range("A1").CurrentRegion
Set rList1 = rList.Cells(2, 1).Resize(rList.Rows.Count - 1, rList.Columns.Count)
With .Sort
.SortFields.Clear
.SortFields.Add Key:=rList1, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rList
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'make into array
aryList = Application.WorksheetFunction.Transpose(rList.Columns(1))
'combine same values
For i = UBound(aryList) To LBound(aryList) + 1 Step -1
If aryList(i) = aryList(i - 1) Then
aryList(i - 1) = aryList(i - 1) & Chr(1) & aryList(i) ' Chr(1) is just marker
aryList(i) = Empty
End If
Next i
'do wonderful stuff with MS Word
For i = LBound(aryList) + 1 To UBound(aryList)
If Not IsEmpty(aryList(i)) Then
sPretendWordDoc = "The Word doc will use ... " & vbCrLf & vbCrLf
v = Split(aryList(i), Chr(1))
For j = LBound(v) To UBound(v)
sPretendWordDoc = sPretendWordDoc & vbTab & v(j) & vbCrLf
Next j
MsgBox sPretendWordDoc
End If
Next i
End Sub