Combine 2 Tables into with Sub Total

[omegaboost]

Dear All,

If I got 2 tables which are Invoice Table (Sheet "Invoice") & Payment Table (Sheet "Payment") and i want to combine those tables into one table as in Sheet "Resume" which have Sub Total by the Invoice Number, is it possible to do it by Pivot table or Power query?
Thank you in advance

Omega Boost

[antoka05]

See attached file, I hope that it's what you need.
I used this code:

Sub Macro1()
   Dim rs, lRow As Long, r As Long
   Dim invSh As Worksheet
   Dim paySh As Worksheet
   Dim resSh As Worksheet
   Dim myDic As Object, oldInvNr As Long
   Dim oldr As Long
   
   'constants for field type
   Const adInteger = 3 'for integer and long
   Const adSingle = 4
   Const adDate = 7
   Const adVarChar = 200
   Const adDouble = 5
   
   On Error GoTo lbl_err
   
   With ThisWorkbook
      'invoice sheet
      Set invSh = .Sheets("invoice")
      'payment sheet
      Set paySh = .Sheets("payment")
      'resume sheet
      Set resSh = .Sheets("resume")
   End With
   
   'create an ADODB.Recordset and call it rs
   Set rs = CreateObject("ADODB.Recordset")
   'dictionary
   Set myDic = CreateObject("scripting.dictionary")
   
   'fields for recordset
   With rs.Fields
      .append "type", adInteger
      .append "inv_nr", adInteger
      .append "inv_date", adDate
      .append "unit", adVarChar, 30
      .append "rcp_nr", adInteger
      .append "rcp_date", adDate
      .append "amount", adInteger
      .append "method", adInteger
   End With
   rs.Open
   
   'Read Invoice sheet
   With invSh
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row
      For r = 4 To lRow
         If Not LCase(invSh.Cells(r, 1)) Like "*total*" Then
            rs.addnew
            rs("type") = 1
            rs("inv_date") = .Cells(r, "b")
            rs("inv_nr") = .Cells(r, "d")
            rs("unit") = .Cells(r, "e")
            rs("amount") = .Cells(r, "f")
            rs.Update
            myDic(CLng(.Cells(r, "d"))) = .Cells(r, "b")
         End If
      Next r
   End With
  
   'Read Payment sheet
   With paySh
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row
      For r = 4 To lRow
         If Not LCase(invSh.Cells(r, 1)) Like "*total*" Then
            rs.addnew
            rs("type") = 2
            rs("inv_date") = myDic(CLng(.Cells(r, "d")))
            rs("rcp_date") = .Cells(r, "a")
            rs("inv_nr") = .Cells(r, "d")
            rs("unit") = .Cells(r, "b")
            rs("rcp_nr") = .Cells(r, "c")
            rs("amount") = .Cells(r, "e")
            If LCase(.Cells(r, "f")) Like "*cash*" Then
               rs("method") = 1
            ElseIf LCase(.Cells(r, "f")) Like "*debit*" Then
               rs("method") = 2
            ElseIf LCase(.Cells(r, "f")) Like "*transfer*" Then
               rs("method") = 3
            End If
            rs.Update
         End If
      Next r
   End With
   
   'Filter recordset
   'rs.Filter = "unit like '*a*'"
   
   'Sort recordset
   '[asc], desc
   rs.Sort = "inv_date, inv_nr, type, rcp_date, rcp_nr"
   
   'output in Resume sheet
   r = 2
   oldr = 3
   
   Application.ScreenUpdating = False
   With resSh
      .Rows("3:" & Rows.Count).Delete
      Do While Not rs.EOF
         r = r + 1
         
         If rs("type") = 1 Then
            'Invoice record
            If oldInvNr <> rs("inv_nr") Then
               If oldInvNr <> 0 Then
                  Call putTotals(resSh, oldr, r)
               
                  r = r + 1
                  oldr = r
               End If
               oldInvNr = rs("inv_nr")
            End If
         
            .Cells(r, "a") = rs("inv_date")
            .Cells(r, "b") = rs("inv_nr")
            .Cells(r, "c") = rs("unit")
            .Cells(r, "d") = rs("amount")
            .Cells(r, 10) = rs("amount")
         Else
            'Payment record
            .Cells(r, "b") = rs("inv_nr")
            .Cells(r, "c") = rs("unit")
            .Cells(r, "e") = rs("rcp_nr")
            .Cells(r, "f") = rs("rcp_date")
            .Cells(r, 6 + rs("method")) = rs("amount")
            .Cells(r, 10) = rs("amount") * -1
         End If
      
         rs.moveNext
      Loop
      rs.Close
      Call putTotals(resSh, oldr, r + 1)
   End With
   Application.ScreenUpdating = True

lbl_exit:
   Exit Sub
   
lbl_err:
   Stop
   Resume Next
End Sub

Sub putTotals(resSh, oldr, r)
   Dim b As Byte
   With resSh
      'sub Total
      .Cells(r, 1) = "Sub TOTAL"
      .Cells(r, 1).Font.Bold = True
      .Cells(r, 1).HorizontalAlignment = xlLeft
      'invoice number
      .Cells(r, 2) = .Cells(r - 1, 2)
      'formula
      .Cells(r, "j") = "=sum(J" & oldr & ":r" & r - 1 & ")"
      .Cells(r, "j").Font.Bold = True
      'borders
      For b = 7 To 11
         'box with data
         With .Range("a" & oldr & ":j" & r - 1).Borders(b)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
         End With
         'sub Total row
         With .Range("a" & r & ":j" & r).Borders(b)
             .LineStyle = xlContinuous
             .ColorIndex = 0
             .TintAndShade = 0
             .Weight = xlThin
         End With
      Next b
   End With
End Sub

Regards,
Antonio