Sorting data in coloums based on another coloum - Code Continuation

A bit of code for you. Go to the VBA IDE (alt-F11), insert a new module, and paste in this code:

Option Explicit

Public Sub btnSortSplit_Click()

    Call SortSplit(Worksheets("Sheet1").Range("I19:J19"), Worksheets("Sheet1").Range("A2"))

End Sub

Public Sub SortSplit(ByVal rngTarget As Excel.Range, ByVal rngDest As Excel.Range)

    Dim arrData         As Variant

    Dim lngLastRow      As Long
    Dim lngLastCol      As Long
    Dim lngCurrRow      As Long
    Dim lngStartRow     As Long
    Dim lngRow2         As Long
    Dim intCol1         As Integer
    Dim intCol2         As Integer
    Dim varOutput       As Variant

    intCol1 = rngDest.Column
    lngLastCol = rngDest.Parent.Rows(rngDest.Row).Find(What:="*", _
        After:=Cells(rngDest.Row, 1), _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Column
    arrData = rngDest.Cells(1, 1).Resize(1, lngLastCol - intCol1 + 1)
    For intCol2 = LBound(arrData, 2) To UBound(arrData, 2)
        If arrData(1, intCol2) = "" Then
            Exit For
        End If
    Next intCol2
    If intCol2 > UBound(arrData, 2) Then
        intCol2 = UBound(arrData, 2)
    End If
    lngLastRow = rngDest.Parent.Columns(intCol1).Resize(, intCol2).Find _
        (What:="*", After:=rngDest.Cells(1, 1), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    rngDest.Resize(lngLastRow - rngDest.Row + 1, intCol2).ClearContents

    intCol2 = rngTarget.Column
    lngLastRow = rngTarget.Parent.Columns(intCol2).Find(What:="*", _
        After:=Cells(1, intCol2), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    rngTarget.Resize(lngLastRow - rngTarget.Row + 1, 2).Sort _
        Key1:=rngTarget.Cells(1, 1), Order1:=xlAscending, _
        Key2:=rngTarget.Cells(1, 2), Order2:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortNormal

    arrData = rngTarget.Offset(1, 0).Resize(lngLastRow - rngTarget.Row, 2)
    varOutput = arrData(1, 1)
    lngStartRow = LBound(arrData)
    For lngCurrRow = LBound(arrData) + 1 To UBound(arrData)
        If arrData(lngCurrRow, 1) <> varOutput Then
            rngDest.Offset(0, intCol1 - 1) = arrData(lngStartRow, 1) & "'s"
            rngDest.Offset(1, intCol1 - 1).Resize(lngCurrRow - lngStartRow, 1).Value _
                = rngTarget.Offset(lngStartRow, 1).Resize(lngCurrRow - lngStartRow, 1).Value
            intCol1 = intCol1 + 1
            lngStartRow = lngCurrRow
            varOutput = arrData(lngCurrRow, 1)
        End If
    Next lngCurrRow
    rngDest.Offset(0, intCol1 - 1) = arrData(lngStartRow, 1) & "'s"
    rngDest.Offset(1, intCol1 - 1).Resize(lngCurrRow - lngStartRow, 1).Value _
        = rngTarget.Offset(lngStartRow, 1).Resize(lngCurrRow - lngStartRow, 1).Value

    Set rngTarget = Nothing
    Set rngDest = Nothing

End Sub

The btnSortSplit_Click procedure calls SortSplit, passing it the header range of the source data and the first cell of the destination. The SortSplit procedure first identifies and clears out any previous results in the destination, sorts the source data, the loops through the sorted source data looking for changes. As changes are found, they are copied to the destination.

Assign the btnSortSplit_Click to a button on your sheet, and you are good to go.