# Summarize data with multiple criteria

#### chunu

##### Board Regular
Hi,
I need help to summarize data as shown in picture.
sum up duplicate invoices amount.
Thanks

[/URL][/IMG]

#### James006

##### Well-known Member
Hi,

Have you tried to Insert a Pivot Table ...?

##### Active Member
Hi
May be
Code:
``````Sub test()
Dim a As Variant, lr, i, x, s, k, itm
a = Range("b3:b" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 4)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
If a(i, 1) <> 0 Then
If Not .exists(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) Then
.Add a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3), a(i, 4)
Else
.Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) = .Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) + a(i, 4)
End If
End If
Next
k = .keys
itm = .items
s = 1
For i = 1 To .Count
x = Split(k(i - 1), Chr(164))
Range("g" & 3 + i - 1).Resize(, UBound(x) + 1) = x
Range("g" & 3 + i - 1).Offset(, 3) = itm(i - 1)
Next
End With``````

Last edited:

#### chunu

##### Board Regular
Hi
May be
Code:
``````Sub test()
Dim a As Variant, lr, i, x, s, k, itm
a = Range("b3:b" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 4)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
If a(i, 1) <> 0 Then
If Not .exists(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) Then
.Add a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3), a(i, 4)
Else
.Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) = .Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) + a(i, 4)
End If
End If
Next
k = .keys
itm = .items
s = 1
For i = 1 To .Count
x = Split(k(i - 1), Chr(164))
Range("g" & 3 + i - 1).Resize(, UBound(x) + 1) = x
Range("g" & 3 + i - 1).Offset(, 3) = itm(i - 1)
Next
End With``````
code is perfect but can you make option to filter by criteria , lets say criteria range cell m2, like advanced filter so i can get result for each customer separately.

#### chunu

##### Board Regular
Hi,

Have you tried to Insert a Pivot Table ...?
thanks james006, i have tried pivot table and its works well but i need simple formula or vba. user mohadin has given vba code that looks good.

##### Active Member
code is perfect but can you make option to filter by criteria , lets say criteria range cell m2, like advanced filter so i can get result for each customer separately.
NOt clear to me
Sorry

#### chunu

##### Board Regular
NOt clear to me
Sorry
Currently its giving the result of whole data ( for all customers)
I am looking for criteria based , like if write customer name in cell m2 and hit command button it should give result only for that customer.

##### Active Member
Like this?
Code:
``````Sub test()    Dim a As Variant, lr, i, x, s, k, itm
a = Range("b3:b" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 4)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
If a(i, 2) = Range("m2") And a(i, 2) <> "" Then
If Not .exists(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) Then
.Add a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3), a(i, 4)
Else
.Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) = .Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) + a(i, 4)
End If
End If
Next
k = .keys
itm = .items
[G:I].ClearContents
For i = 1 To .Count
x = Split(k(i - 1), Chr(164))
Range("g" & 3 + i - 1).Resize(, UBound(x) + 1) = x
Range("g" & 3 + i - 1).Offset(, 3) = itm(i - 1)
Next
End With
End Sub``````

Last edited:

#### chunu

##### Board Regular
Like this?
Code:
``````Sub test()    Dim a As Variant, lr, i, x, s, k, itm
a = Range("b3:b" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 4)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
If a(i, 2) = Range("m2") And a(i, 2) <> "" Then
If Not .exists(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) Then
.Add a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3), a(i, 4)
Else
.Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) = .Item(a(i, 1) & Chr(164) & a(i, 2) & Chr(164) & a(i, 3)) + a(i, 4)
End If
End If
Next
k = .keys
itm = .items
[G:I].ClearContents
For i = 1 To .Count
x = Split(k(i - 1), Chr(164))
Range("g" & 3 + i - 1).Resize(, UBound(x) + 1) = x
Range("g" & 3 + i - 1).Offset(, 3) = itm(i - 1)
Next
End With
End Sub``````
Excellent , Thank you so much.

##### Active Member
You are very well come
Thank you for the feedback
Be happy