Continuous/Automatic Data Integration From Two Tables into One

Further post #2, please add an example of the integrated table.

And how (manual input / extraction from another source) are the "Purchase", "Sales" and "Bank Transactions" sheets updated? and with what frequency ?

first of all thanks for giving me your time...
as for the questions-

• I want to integrate Purchase & Bank Transactions(Payment part/dr part) / Sales & Bank Transactions(receipt part/cr part)... if it will be a problem feel free to separate them into receipt and payment tables...
• Sales, Purchase, Bank Transactions(the first three sheets) will be entered manually and then will be combined in groups of sales+reciept(bank transactions) & purchase+payments(bank transactions)
• the Sales, Purchase, Bank Transactions sheets will be updated everyday...
• I have improved the attachment file

feel free to ask if there is anything else

Sub SPB()

Dim ar1, ar2, arr(), txid()
Dim hdr(0 To 1)
Dim rng As Range, destination As Range
Dim i As Long, j As Long
Dim ws1 As Worksheet

wksh = Array("Purchase", "Sales", "Bank Transactions", "Result")
hdr(1) = Array("S.no", "Bill No.", "Date", "Party name", "Amount", "Paid/Dr", "Balance")
hdr(0) = Array("S.no", "Bill No.", "Date", "Party name", "Amount", "Received/Dr", "Balance")

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set ws1 = Worksheets(wksh(2))
ws1.Activate

ar1 = [A1].CurrentRegion
lr = Cells(Rows.Count, 1).End(xlUp).Row
txid = Range("E2:E" & lr)

For ws = 0 To 1

   ReDim arr(1 To 1000, 1 To 7)

    Set ws1 = Worksheets(wksh(ws))
    ws1.Activate
'
    ar2 = Range("A1").CurrentRegion
    n = 0
    For r = 2 To UBound(ar2, 1)
        n = n + 1
        For c = 2 To 5
            arr(n, c) = ar2(r, c)
        Next c
        arr(n, 7) = ar2(r, 5)
    Next r
    
    If ws = 0 Then typex = "P" Else typex = "S"
    
    For r = 2 To UBound(ar1, 1)
        If UCase(Left(ar1(r, 5), 1)) = typex Then
            n = n + 1
            arr(n, 2) = ar1(r, 5)
            arr(n, 3) = ar1(r, 1)
            arr(n, 4) = ar1(r, 3)
            arr(n, 6) = ar1(r, 7 + ws)
            arr(n, 7) = 0
        End If
    Next r


Set ws1 = Worksheets("Sheet1")
With ws1
    .Cells(1, ws * 9 + 1).Resize(1, 7) = hdr(ws)
    .Cells(2, ws * 9 + 1).Resize(n, 7).Value = arr
     If ws = 0 Then
         .Columns("A:G").Sort key1:=.Range("B2"), order1:=xlAscending, Header:=xlYes
     Else
         .Columns("J:P").Sort key1:=.Range("K2"), order1:=xlAscending, Header:=xlYes
     End If
    For i = 1 To n
    .Cells(i + 1, ws * 9 + 1) = i
    Next i
End With

Next ws

'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

See Sheet1

Please confirm calculations in columns H and Q are correct then I will add to VBA

@JohnTopley Sir very sorry for the late reply,
And once again thank you for your help...

the calculations in columns H and Q are correct...

Alternative solution using Power Query

let
    Source = Table.NestedJoin(Table2, {"Bill no."}, Table1, {"Payment disc/info"}, "Table1", JoinKind.LeftOuter),
    #"Expanded Table1" = Table.ExpandTableColumn(Source, "Table1", {"Transaction#(lf)Date", "Debit#(lf)(Dr.) INR"}, {"Table1.Transaction#(lf)Date", "Table1.Debit#(lf)(Dr.) INR"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Expanded Table1",{"S.no", "Bill no.", "Date", "Table1.Transaction#(lf)Date", "Party Name", "Amount", "Table1.Debit#(lf)(Dr.) INR"})
in
    #"Reordered Columns"

and

let
    Source = Table.NestedJoin(Table24, {"Bill no."}, Table1, {"Payment disc/info"}, "Table1", JoinKind.LeftOuter),
    #"Expanded Table1" = Table.ExpandTableColumn(Source, "Table1", {"Transaction#(lf)Date", "Credit#(lf)(Cr.) INR"}, {"Table1.Transaction#(lf)Date", "Table1.Credit#(lf)(Cr.) INR"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Expanded Table1",{"S.no", "Bill no.", "Date", "Table1.Transaction#(lf)Date", "Table1.Credit#(lf)(Cr.) INR", "Party Name", "Amount"})


in
    #"Reordered Columns"

Updated VBA

Sub SPB()

Dim ar1, ar2, arr(), txid()
Dim hdr(0 To 1)
Dim rng As Range, destination As Range
Dim i As Long, j As Long
Dim ws1 As Worksheet

wksh = Array("Purchase", "Sales", "Bank Transactions", "Result")
hdr(1) = Array("S.no", "Bill No.", "Date", "Party name", "Amount", "Paid/Dr", "Balance")
hdr(0) = Array("S.no", "Bill No.", "Date", "Party name", "Amount", "Received/Dr", "Balance")

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set ws1 = Worksheets(wksh(2))
ws1.Activate

ar1 = [A1].CurrentRegion
lr = Cells(Rows.Count, 1).End(xlUp).Row
txid = Range("E2:E" & lr)

For ws = 0 To 1

   ReDim arr(1 To 1000, 1 To 7)

    Set ws1 = Worksheets(wksh(ws))
    ws1.Activate
'
    ar2 = Range("A1").CurrentRegion
    n = 0
    For r = 2 To UBound(ar2, 1)
        n = n + 1
        For c = 2 To 5
            arr(n, c) = ar2(r, c)
        Next c
        arr(n, 7) = ar2(r, 5)
    Next r
    
    If ws = 0 Then typex = "P" Else typex = "S"
    
    For r = 2 To UBound(ar1, 1)
        If UCase(Left(ar1(r, 5), 1)) = typex Then
            n = n + 1
            arr(n, 2) = ar1(r, 5)
            arr(n, 3) = ar1(r, 1)
            arr(n, 4) = ar1(r, 3)
            arr(n, 6) = ar1(r, 7 + ws)
            arr(n, 7) = 0
        End If
    Next r


Set ws1 = Worksheets("Sheet1")
With ws1
    .Cells(1, ws * 9 + 1).Resize(1, 7) = hdr(ws)
    .Cells(2, ws * 9 + 1).Resize(n, 7).Value = arr
     If ws = 0 Then
         .Columns("A:G").Sort key1:=.Range("B2"), order1:=xlAscending, Header:=xlYes
         With .Range("G2:G" & n + 1)
            .Formula = "=SUMIFS($E$2:$E2,$D$2:$D2,$D2)-SUMIFS($F$2:$F2,$D$2:$D2,$D2)"
            .Value = .Value
        End With
     Else
         .Columns("J:P").Sort key1:=.Range("K2"), order1:=xlAscending, Header:=xlYes
         With .Range("P2:P" & n + 1)
            .Formula = "=SUMIFS($N$2:$N2,$M$2:$M2,$M2)-SUMIFS($O$2:$O2,$M$2:$M2,$M2)"
            .Value = .Value
         End With
     End If
     
    For i = 1 To n
    .Cells(i + 1, ws * 9 + 1) = i
    Next i
End With

Next ws

ws1.Activate

'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True



End Sub

As requested:

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

Yeah,
That is because you needed to load each of the tables into PQ Editor before merging them. Here attached is your file with my solutions

Attached runs on Workbook_Open But I have left the "Run" button (delete if not required)

it causes problems in entries of partial payment

... and would it have been nice if your example showed such characteristics instead of wasting our time with a non-realistic example of your data.

Post the more realistic data sample here.

As per Ali's reply: post a realistic sample workbook with ALL sheets included. The volume (number of rows) is not a problem BUT let us know the likely maximum for any sheet.

Capture.PNG
Sir Can you please remove the balance column from the VBA program
as it is having problems I can do it with Formulas(sorry I made a mistake in the picture the 1st one should be -310000 and 2nd should be -440304)

Sir here is the sample
Sir Please pick the Sales/Purchase Data from the second table in the sales worksheet
Sie, Very Sorry for the trouble and thanks a lot for your help