How to alphabetically sort values in a dynamic range?

Hi, max3732,

if you have more than one item to be listed patel45īs code will fail as only one cell is copied over (wiull always copy Column B to Column C no matter what information is on that line).

First suggestion is to combine the contents in Column B:

Sub SortCombineCellContents()
  Dim lngRC As Long
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    .SetRange ActiveSheet.Range("A1").CurrentRegion
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  With ActiveSheet
    For lngRC = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If .Cells(lngRC, 1).Value = .Cells(lngRC - 1, 1).Value Then
        .Cells(lngRC - 1, 2).Value = .Cells(lngRC - 1, 2).Value & ", " & .Cells(lngRC, 2).Value
        .Rows(lngRC).Delete
      End If
    Next lngRC
  End With
End Sub

Second would be to add the cells to the right of the first line the item appears on:

Sub SortAddCellContentsToRight()
  Dim lngRC As Long
  Dim lngUC As Long
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    .SetRange ActiveSheet.Range("A1").CurrentRegion
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  With ActiveSheet
    For lngRC = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If .Cells(lngRC, 1).Value = .Cells(lngRC - 1, 1).Value Then
        lngUC = .Cells(lngRC, Columns.Count).End(xlToLeft).Column
        .Cells(lngRC - 1, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, lngUC - 1).Value = .Cells(lngRC, 2).Resize(1, lngUC - 1).Value
        .Rows(lngRC).Delete
      End If
    Next lngRC
  End With
End Sub

In your code sample you mention SortRng which depends on SortSt which isnīt defined. You should make sure to include this information for us if you post a procedure which is causing trouble.

Ciao,
Holger