I have a table as shown below, I want to create another one that put all
Territory together into one cell that corresponding to unique County.

County Territory
Bell 0033
Bell 0036
Bell 0034
Boone 0052
Boone 0053
Boone 0055
Boone 0046
Boone 0054


County Territory
Bell 0031, 0034, 0036
Boone 0052, 0053, 0055, 0046, 0054

My VB skill is very limited:(
My code is:

Sub Union()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Dim iRows As Long, mRow As Long, ir As Integer, ic As Integer, rng As Range
iRows = Selection.Rows.Count
Set Lastcell = Cells.SpecialCells(xlLastCell)
mRow = Lastcell.Row
If mRow < iRows Then iRows = mRow
Set rng = ActiveSheet.Range(G1, H26)

For ic = 1 To 26

County = rng.Item(ic, 1).Value
Terr = rng.Item(ic, 2).Value
For ir = 1 To iRows
Combined = Selection.Item(ir, 2).Value
Compared = Trim(Selection.Item(ir, 1).Value)
If County = Compared Then Terr = Terr & ", " & Combined
Next ir
Next ic
Application.ScreenUpdating = True

End Sub

Please help.
Thanks,