Sub TEST()
Dim Arr, xD, i&, j&, N&, T$, U&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([RAW!CE1], [RAW!A1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 3): If Len(T) <> 13 Then GoTo 101
T = Left(T, 12) & "X": U = xD(T)
If U = 0 Then
For j = 1 To UBound(Arr, 2): Arr(N + 2, j) = Arr(i, j): Next
Arr(N + 2, 3) = T: N = N + 1: xD(T) = N: GoTo 101
End If
For j = 4 To UBound(Arr, 2)
Arr(U + 1, j) = Val(Arr(U + 1, j)) + Val(Arr(i, j))
Next j
101: Next i
With Sheets("After")
.UsedRange.ClearContents
If N = 0 Then Exit Sub
.[A1:CE1].NumberFormatLocal = "@"
.[A1:CE1].Resize(N + 1) = Arr
End With
End Sub
