How to summary by ColumnA + ColumnB + ColumnC by VBA ?

[moonhk]

How to summary by ColumnA + ColumnB + ColumnC by VBA ?
Column B and ColumnC are unsorted columns.
Column D is amount, need to summary.

I prefer using array or collection be build a summary list.

The number of data less than 1000 rows.

Column A Column B ColumnC Column D
6321002974 61901990 010-BT 1,510.00
6321002974 61901990 010-BT 3,628.59
6321002974 61901990 010-BT 4,239.76
6321002974 61901990 010-BT 2,527.06
6321002974 61901990 010-BT 1,611.77
6321002974 61901990 010-BT (10,118.32)
6321002974 61901991 010-BT 4,163.95
6321002974 61901991 010-BT 2,081.97
6321002974 61901991 010-BT 2,081.97
6321002974 61901991 010-BT 2,079.46
6321002974 61901991 010-BT (2,081.97)
6321002974 61901991 010-BT (2,081.97)
6321002974 61901991 010-BT (4,163.95)
6321002974 61901991 010-BT (2,081.97)
6321002975 61000000 130-BT 240.89
6321002975 61000000 130-BT 1,180.70
6321002975 61100000 130-BT 16.86
6321002975 61100000 130-BT 177.18
6321002975 61100000 130-BT 58.96
6321002975 61100000 130-BT 7.19
6321002975 61100000 130-BT 101.16

 

[moonhk]

I have wrote below coding fro calculate Summary by ColumnA + ColumnB +
ColumnC
using array.

Sub xx()
Dim SubTotal As New ClsSubTotal
SubTotal.init
SubTotal.addItem "moon hk", 15
SubTotal.addItem "moon hk", 5
SubTotal.addItem "moon" + Chr(9), 13
SubTotal.addItem "moon", 11
SubTotal.addItem "moonhk", 10.000000099
SubTotal.showMe
Set SubTotal = Nothing
End Sub


Option Explicit
'~~ 2006/11/13
'~~ Class name : clsSubTotal
Private Title As String
Private varData(4000, 1) As Variant
Private cnt As Long


Public Sub init()
Dim i As Long
If cnt > 0 Then
For i = 0 To cnt
varData(i, 0) = ""
varData(i, 1) = 0
Next i
End If
cnt = 0
End Sub

Public Sub addTitle(loString As String)
Title = loString
End Sub

Public Sub addItem(loString As String, loValue As Double)
Dim i As Long
Dim loFound As Boolean
loFound = False
'~~Debug.Print loString + " ->" + Str(loValue)
i = 0
Do
If varData(i, 0) = loString Then
'~~Debug.Print "Found"
'~~Debug.Print "key " + varData(i, 0)
'~~Debug.Print "value " + Str(varData(i, 1))
varData(i, 1) = varData(i, 1) + loValue
loFound = True
End If
i = i + 1
Loop While ((loFound = False) And (i <= cnt))

If loFound = False Then
'~~Debug.Print "Create for " + loString + " " + Str(loValue)
varData(cnt, 0) = loString
varData(cnt, 1) = loValue
cnt = cnt + 1
End If
End Sub

Public Sub SubTotalAmount()
Dim i As Long
Dim total As Double
total = 0
For i = 0 To cnt - 1
total = total + varData(i, 1)
Next i
MsgBox "Total= " & total & " " & "cnt = " & i
End Sub

Public Sub showMe()
Dim i As Long
If cnt - 1 >= 0 Then
For i = 0 To cnt - 1
MsgBox "Showme " & Str(i) + " " + varData(i, 0) + " " +
Str(varData(i, 1))
Next i
Else
MsgBox "No Element"
End If

End Sub

Public Sub Extract_Data(loSheet As Worksheet, loCells As String)
Dim i, j, k As Long
Dim kArray As Variant
For i = 1 To cnt - 1
kArray = Split(varData(i, 0), "|", -1, vbTextCompare)

If kArray(1) = " 0" Then
'MsgBox "0"
End If

If VBA.Trim(kArray(1)) <> "0" Then

k = k + 1
For j = 0 To UBound(kArray)
loSheet.Range(loCells).Offset(k, j + 1).Value = kArray(j)
Next
loSheet.Range(loCells).Offset(k, 4).Value = varData(i, 1)
Else
Debug.Print "k=" & Str(k) & " [" & kArray(1) & "]"
End If
Next

End Sub