CODEWITHSUNDEEP
vbaexcel
Krsnik195
Krsnik195

Reputation: 79

Real time combine data from multiple worksheets into a summary worksheet

I have data in multiple Data worksheets that want to combine into Summary worksheet. When user update data in any Data worksheet, it will copy information automatically to Summary worksheet.

For example

(Input) Data worksheet1 

 |   A   |    B   |   C   |
    Cat      Red     Male
    Dog     Green   Female

(Input) Data worksheet2 

 |   A   |    B   |   C   |
  Monkey   Brown    Male
    Ant     Blue     Male
   Bird     White   Female

(Output) Summary Worksheet 

 |   A   |    B   |   C   |
    Cat      Red     Male
    Dog     Green   Female
  Monkey    Brown    Male
    Ant     Blue     Male
   Bird     White   Female

Right now my code running okay with one data worksheet. But when I try to switch to work on another data worksheet, the data on summary worksheet will not correct. It also has some errors when I delete all information or when I change the code (I need to reopen it).

Here is my code

ThisWorkBook

Public Sub Workbook_Open()

Set WB = ThisWorkbook
Set ActWS = WB.ActiveSheet
Set MainWS = WB.Worksheets("Main")

ActWSPreLastRow = ActWS.Cells(ActWS.Rows.Count, "A").End(xlUp).Row
MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

End Sub

Module

Public WB As Workbook
Public ActWS As Worksheet
Public MainWS As Worksheet
Public ActWSPreLastRow As Long
Public ActWSStoredLastRow As Long
Public MainWSPreLastRow As Long
Public MainWSStoredLastRow As Long
Public MainWSEndLastRow As Long
Public I As Long

Public Sub DoCopy()

Set WB = ThisWorkbook
Set ActWS = WB.ActiveSheet
Set MainWS = WB.Worksheets("Main")

ActWSPreLastRow = ActWS.Cells(ActWS.Rows.Count, "A").End(xlUp).Row
MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

I = MainWSStoredLastRow + (ActWSPreLastRow - ActWSStoredLastRow)

MainWS.Range("A" & MainWSStoredLastRow + 1, "AQ" & I).Value = _
ActWS.Range("A" & ActWSStoredLastRow + 1, "AQ" & ActWSPreLastRow).Value

MainWSPreLastRow = MainWS.Cells(MainWS.Rows.Count, "A").End(xlUp).Row

End Sub

Public Sub StoreOld()
ActWSStoredLastRow = ActWSPreLastRow
MainWSStoredLastRow = MainWSPreLastRow

End Sub

Other worksheets

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A5:AQ1000")) Is Nothing Then
    Call StoreOld
    Call DoCopy
End If
End Sub

Upvotes: 0

Views: 1133

Answers (1)

AnalystCave.com
AnalystCave.com

Reputation: 4974

Microsoft Query to the rescue:

SELECT A,B,C FROM [Sheet1$] 
UNION ALL
SELECT A,B,C FROM [Sheet2$]

Data->From Other Sources->Microsoft Query or feel free to use my Add-In.

Then simply refresh the Query when needed (via 1 line VBA or right-click on the table and click refresh).

Details

Assuming that the structure of Sheet1 & Sheet2 are:

(Input) Data worksheet1 (with row numbers)

 1    |   A   |    B   |   C   |
 2       Cat      Red     Male
 3       Dog     Green   Female

(Input) Data worksheet2 (with row numbers)

 1    |   A   |    B   |   C   |
 2     Monkey   Brown    Male
 3       Ant     Blue     Male
 4      Bird     White   Female

Then:

  1. Create a new worksheet (Sheet3)

  2. Create the Query with the SQL above.

If you want to add a condition add a WHERE clause to one or both of the SELECTs

Upvotes: 2

Related Questions