Sub SortandSum()
Dim LR1 As Integer, LR2 As Integer
Dim i As Integer, j As Integer, Count1 As Integer, Count2 As Integer
Dim aID
Dim rDest1 As Range, rDest2 As Range, rDestSub As Range
Dim colLengths() As Integer
aID = Array("A", "B", "C")
ReDim colLengths(UBound(aID))
With Sheets("Sheet1")
'define data ranges
LR1 = .Range("A" & .Rows.Count).End(xlUp).Row
LR2 = .Range("D" & .Rows.Count).End(xlUp).Row
'determine max no. of data values (ID1 or ID2)
For i = 0 To UBound(aID)
Count1 = Application.WorksheetFunction.CountIf(.Range("A9:A" & LR1), aID(i))
Count2 = Application.WorksheetFunction.CountIf(.Range("D9:D" & LR2), aID(i))
colLengths(i) = max(Count1, Count2)
Next i
'Set up receiving sheet
With Sheets("Sheet2")
.Range("B1").Resize(1, 6) = Array("TEA ID1", "Value1", , , "TEA ID2", "Value2")
Set rDestSub = .Range("A1")
Set rDest1 = .Range("B2")
Set rDest2 = .Range("F2")
End With
'Receive the data
For i = 0 To UBound(colLengths)
For j = 1 To max(LR1, LR2)
If .Cells(j, 1) = aID(i) Then
rDest1.Value = aID(i)
rDest1.Offset(0, 1).Value = .Cells(j, 2)
Set rDest1 = rDest1.Offset(1, 0)
End If
If .Cells(j, 4) = aID(i) Then
rDest2.Value = aID(i)
rDest2.Offset(0, 1).Value = .Cells(j, 5)
Set rDest2 = rDest2.Offset(1, 0)
End If
Next j
Set rDestSub = rDestSub.Offset(colLengths(i) + 1, 0)
rDestSub.Resize(1, 7) = Array("Sum", aID(i), Application.WorksheetFunction.SumIf(.Range("A9:A" & LR1), aID(i), .Range("B9:B" & LR1)) _
, , "Sum", aID(i), Application.WorksheetFunction.SumIf(.Range("D9:D" & LR1), aID(i), .Range("E9:E" & LR1)))
Set rDest1 = rDestSub.Offset(1, 1)
Set rDest2 = rDestSub.Offset(1, 5)
Next i
End With
End Sub
Function max(i As Integer, j As Integer)
If i > j Then
max = i
Else
max = j
End If
End Function