Macro to SUMIFS based on certain criteria and CONCATENATE Transaction nos.

Dear Friends,

I have a data in which date, transaction nos, type, amount collected etc are there. The no. of data may vary based on daywise collections.

Therefore, for summary, I need to SUMIFS the data (which is possible using Pivot but not in the required format) and CONCATENATE the transaction nos. as per the grouped data.

I attached the Excel file in which I furnished the detailed data and the SAMPLE OUTPUT requirement also.

Please help me to resolve.

Maybe :

Sub Test()
  Dim a, b, c As New Collection, i As Long, j As Long, strKey As String, v1, v2, v3, v4
  With Sheets("Data")
    a = .Range("A1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * 10, 1 To 5)
    For i = 3 To UBound(a, 1)
        On Error Resume Next
           strKey = CStr(a(i, 2))
           c.Add key:=strKey, Item:=Array(a(i, 2), New Collection)
           With c(strKey)(1)
             strKey = CStr(a(i, 12))
             .Add key:=strKey, Item:=Array(a(i, 12), New Collection)
             With .Item(strKey)(1)
               For j = 3 To 13
                   If j <> 12 Then
                      .Add key:=a(2, j), Item:=Array(a(2, j), New Collection)
                      With .Item(a(2, j))(1)
                        .Add Array(a(i, j), a(i, 1))
                      End With
                   End If
               Next j
             End With
           End With
        On Error GoTo 0
    Next i
    b(1, 1) = "Date"
    b(1, 2) = "Type"
    b(1, 3) = "Sum of"
    b(1, 4) = "Amt"
    b(1, 5) = "TransNo"
    i = 2
    For Each v1 In c
        b(i, 1) = v1(0)
        For Each v2 In v1(1)
            b(i, 2) = v2(0)
            For Each v3 In v2(1)
                b(i, 3) = v3(0)
                For Each v4 In v3(1)
                    b(i, 4) = b(i, 4) + v4(0)
                    b(i, 5) = b(i, 5) & ", " & v4(1)
                Next v4
                b(i, 5) = Mid$(b(i, 5), 3)
                i = i + 1
            Next v3
        Next v2
    Next v1
    i = i - 1
    For j = 2 To i
        If b(j, 1) = "" Then b(j, 1) = b(j - 1, 1)
        If b(j, 2) = "" Then b(j, 2) = b(j - 1, 2)
    Next j
    With .Range("U2").Resize(i, UBound(b, 2))
      .Value = b
      .EntireColumn.AutoFit
      .Borders.Weight = xlThin
    End With
  End With
End Sub

Dear Sir,

Thanks for your kind & swift support. You are Great Sir.

Dear Sir,
The above code is simply superb.

I need one more help in the above to apply in another file.

Almost the process is same, but the no. of SUMMING columns are less. And NO NEED TO CONCATENATE any column also.

I attached the sample file for your kind help. Please Sir.

You are welcome, thanks for marking the thread as solved and rep.points.

Regards

Should be :

Sub Test()
  Dim a, b, c As New Collection, i As Long, j As Long, strKey As String, t, v1, v2, v3, v4
  With Sheets("Data")
    a = .Range("A1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To 4)
    For i = 3 To UBound(a, 1)
        On Error Resume Next
           strKey = CStr(a(i, 2))
           c.Add key:=strKey, Item:=Array(a(i, 2), New Collection, New Collection)
           c(strKey)(2).Add a(i, 14)
           With c(strKey)(1)
             strKey = CStr(a(i, 13))
             .Add key:=strKey, Item:=Array(a(i, 13), New Collection)
             With .Item(strKey)(1)
               For j = 3 To 11
                   .Add a(i, j)
               Next
             End With
           End With
        On Error GoTo 0
    Next i
    b(1, 1) = "Date"
    b(1, 2) = "Type"
    b(1, 3) = "Sum of"
    b(1, 4) = "Amt"
    i = 2
    For Each v1 In c
        For Each v2 In v1(1)
            b(i, 1) = v1(0)
            b(i, 2) = v2(0)
            b(i, 3) = "Sum of TOTAL"
            For Each v3 In v2(1)
                b(i, 4) = b(i, 4) + v3
            Next v3
            i = i + 1
        Next v2
        t = 0
        For Each v2 In v1(2)
            t = t + v2
        Next v2
        b(i, 1) = v1(0)
        b(i, 3) = "Sum of Charges"
        b(i, 4) = t
        i = i + 1
    Next v1
    i = i - 1
    With .Range("U2").Resize(i, UBound(b, 2))
      .Value = b
      .EntireColumn.AutoFit
      .Borders.Weight = xlThin
      .Sort key1:=.Columns(1), key2:=.Columns(2), header:=xlYes
    End With
  End With
End Sub

Oh ! You Beauty....
Great Sir. Take a Bow......
Thanks a lot Sir.

You are welcome.

Don't forget to mark this thread as solved :
If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.

Dear Sir,
It worked very fine. I attached the Excel file in which I applied your code.

1) Your code works nicely in the table (sheet "Data1").

2) When I applied your code in sheet "Data2", then it returns with "Error #9 - Subscript out of range". What may be the issue? I tried my level best, but couldn't.

I attached the Excel File with both sheets & codes ("coderight" for sheet "data1" & "codewrong" for sheet "data2"), to run instantly to find error message.

Please help me to resolve it Sir.

Please change this line :

ReDim b(1 To UBound(a, 1), 1 To 4)

into this :

ReDim b(1 To UBound(a, 1) * 2, 1 To 4)