Summarize data with multiple criteria

chunu

Board Regular
Joined
Jul 5, 2012
Messages
74
Hi,
I need help to summarize data as shown in picture.
sum up duplicate invoices amount.
Thanks

[/URL][/IMG]
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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
Joined
Jul 5, 2012
Messages
74
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
Thanks mohadin
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
Joined
Jul 5, 2012
Messages
74
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.
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Thanks mohadin
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
Joined
Jul 5, 2012
Messages
74
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.
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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
Joined
Jul 5, 2012
Messages
74
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.
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
You are very well come
Thank you for the feedback
Be happy
 

Forum statistics

Threads
1,085,174
Messages
5,382,135
Members
401,775
Latest member
BredAnderson

Some videos you may like

This Week's Hot Topics

Top