Summarize data with multiple criteria

[chunu]

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

[/URL][/IMG]

 

[James006]

Hi,

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

 

[mohadin]

Hi
May be

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

 

[chunu]

Hi
May be

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]

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]

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]

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]

Like this?

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

 

[chunu]

Like this?

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]

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