Combine data from multiple rows into one row when other column data changes

Try this:

Option Explicit

Sub MergeRows()
Dim LR As Long, Rw As Long, DelRng As Range

LR = Range("A" & Rows.Count).End(xlUp).Row

Range("F2:F" & LR).FormulaR1C1 = "=MATCH(RC[-3], {""CW"",""CF"",""MC""}, 0)"
Range("A1").CurrentRegion.Sort Range("A2"), xlAscending, Range("F2"), , xlAscending, Header:=xlYes
Range("F2:F" & LR).ClearContents

Set DelRng = Range("A" & LR + 1)

For Rw = LR To 3 Step -1
    If Range("A" & Rw) = Range("A" & Rw - 1) Then
        Range("C" & Rw - 1) = Range("C" & Rw - 1) & "," & Range("C" & Rw)
        Set DelRng = Union(DelRng, Range("A" & Rw))
    End If
Next Rw

If Not DelRng Is Nothing Then DelRng.EntireRow.Delete xlShiftUp
End Sub

My approach is a little bit different, but at least it doesn't limited to only CW, CF and MC.

Sub Consolidate()
Dim MyCollection As Collection
Dim ws As Worksheet
Dim LR As Long, i As Long, j As Long
Dim LR_Cust As Long
Dim strCustomer As String

Set MyCollection = New Collection
Set ws = ActiveSheet

With ws
LR = .Cells(Rows.Count, 1).End(xlUp).Row
    .Columns("I:M").Delete
    .Range("A1:B" & LR & ",D1:E" & LR).Copy .Cells(1, 9)
    .Cells(1, 9).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    .Columns("K").Insert
    .Cells(1, "K").Value = "Program"
    
LR_Cust = .Cells(Rows.Count, 9).End(xlUp).Row
    For i = 2 To LR_Cust
        For j = 2 To LR
            If .Cells(j, 2).Value = .Cells(i, 10).Value Then
                strCustomer = strCustomer & "," & .Cells(j, 3).Value
            End If
        Next j
            strCustomer = Right(strCustomer, Len(strCustomer) - 1)
            MyCollection.Add strCustomer, .Cells(i, 10)
            strCustomer = ""
    Next i
    
    For i = 2 To LR_Cust
        .Cells(i, "K").Value = MyCollection.Item(.Cells(i, "J").Value)
    Next i
End With

End Sub

My macro with the tweaks needed. Notice the "formula" line of code, that is where you edit the codes listed and the order they are in, the codes are put into that order. You can add more if needed within that formula.

Option Explicit

Sub MergeRows()
Dim LR As Long, Rw As Long, DelRng As Range

LR = Range("A" & Rows.Count).End(xlUp).Row

Range("F2:F" & LR).FormulaR1C1 = "=MATCH(RC3, {""CW"",""FS"",""MC""}, 0)"
Range("A1").CurrentRegion.Sort Range("A2"), xlAscending, Range("F2"), , xlAscending, Header:=xlYes
Range("F2:F" & LR).ClearContents

Set DelRng = Range("A" & LR + 1)

For Rw = LR To 3 Step -1          'start from the bottom and work upwards
    If Range("A" & Rw) = Range("A" & Rw - 1) Then
      'this line merges the codes upward
        Range("C" & Rw - 1) = Range("C" & Rw - 1) & ", " & Range("C" & Rw)
      'this line merges the dates upward
        Range("D" & Rw - 1) = Format(Range("D" & Rw - 1), "M/D/YYYY") & ", " & Format(Range("D" & Rw), "M/D/YYYY")
        Set DelRng = Union(DelRng, Range("A" & Rw))
    End If
Next Rw

If Not DelRng Is Nothing Then DelRng.EntireRow.Delete xlShiftUp
Range("C:D").Columns.AutoFit
Range("D:D").HorizontalAlignment = xlRight
End Sub

Yes, but I believe the results would be nonsensical after that. If some codes renew in the same months and others do not, you would end up with a concatenated list that was no longer clear which date goes with each code. 2 codes and 1 date, not problem. But 3 codes and 2 dates.... odd. I would suggest you leave it as is.