Join text into one cell in various row and column - excel

Question

I have a spreadsheet that has values that looks similar to below :
Is there any possible way to create VBA to join all the separate data together for each ID and Class into one row? So that the ending result would look like below?
Sub JoinRowsData()
Dim lastRow As Long, i As Long, j As Long, k As Long
Application.ScreenUpdating = False
lastRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
For j = i + 1 To lastRow
If Cells(i, 2) = Cells(j, 2) Then
For k = 5 To 10
If (Cells(i, k) = "" And Cells(j, k) <> "") Then
Cells(i, k) = Cells(j, k)
End If
Next
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Answer 1

The following will do it. See the comments for an explanation how it works. It uses arrays to process the data which is much faster than process cells directly.
Option Explicit
Public Sub JoinRowsData()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long ' get last used row in worksheet
LastRow = GetLastUsed(xlByRows, ws)
Dim LastCol As Long ' get last used column in worksheet
LastCol = GetLastUsed(xlByColumns, ws)
' Read data into an array for faster processing
Dim Data() As Variant
Data = ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2
' define an output array with the same size
Dim Output() As Variant
ReDim Output(1 To UBound(Data, 1), 1 To UBound(Data, 2))
Dim outRow As Long ' output row index
Dim iRow As Long
For iRow = 1 To LastRow ' loop through all rows in data
' if column 1 contains data it is a new output row
If Data(iRow, 1) <> vbNullString Then
outRow = outRow + 1
End If
' loop through all columns in a data row
Dim iCol As Long
For iCol = 1 To LastCol
If Data(iRow, iCol) <> vbNullString Then ' check if current cell has data
If Output(outRow, iCol) <> vbNullString Then
' add a line break if there is already data in the output cell
Output(outRow, iCol) = Output(outRow, iCol) & vbLf
End If
' add the data to the output cell
Output(outRow, iCol) = Output(outRow, iCol) & Data(iRow, iCol)
End If
Next iCol
Next iRow
' write all the output data from the array back to the cells
ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2 = Output
End Sub
' find last used row or column in worksheet
Public Function GetLastUsed(ByVal RowCol As XlSearchOrder, ByVal InWorksheet As Worksheet) As Long
With InWorksheet
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
Dim LastCell As Range
Set LastCell = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=RowCol, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If RowCol = xlByRows Then
GetLastUsed = LastCell.Row
Else
GetLastUsed = LastCell.Column
End If
Else
GetLastUsed = 1
End If
End With
End Function