Sync Multipe Worksheets

1
votes

I'm trying to get Excel VBA to do "two-way" updating of linked data between Worksheets. Sheet1 is a summary table and Sheet2,3,4... are more detailed data. The challenge is that data entry can occur two locations...in the Summary Sheet1, or in one of the connected Worksheets.

As an analogy this could be like having an Annual Budget summary worksheet with supporting worksheets for each month's expenditures. However, data can be entered in either location.

In a nutshell, if you are in Sheet1 and change the data, it will update Sheet2,Sheet3, Sheet4, etc. and if you are in Sheet2,Sheet3, Sheet4 and change the data, it will update summary table in Sheet1.

I found a similar working solution that keeps a single cell A1 updated between Sheet1 and Sheet2:

Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Sheets("Sheet2").Range("A1").Value = Target.Value
Application.EnableEvents = True
End Sub

Sheet2

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Sheets("Sheet1").Range("A1").Value = Target.Value
Application.EnableEvents = True
End Sub

However, what I'm really after is a bigger version of this to have a "summary table" of rows of data in Sheet1 update/sync with multiple other worksheets. Each worksheet corresponds to a single row in the Sheet1 table.

Here's a simplified example of what the worksheets contain.

Sheet1 "Summary Table"

A1:C1 'Row 1 data in Summary Table {1,2,3}
A2:C2 'Row 2 data in Summary Table {4,5,6}
Ai:Ci 'Row i data in Summary Table (7,8,9}

Sheet2

A1:C1 'Data Corresponding to Summary Table Row 1 {1,2,3}

Sheet3

A1:C1 'Data Corresponding to Summary Table Row 2 {4,5,6}

Sheet4

A1:C1 'Data Corresponding to Summary Table Row 3 {7,8,9}

Any advice on this problem would be much appreciated! Thanks!

Sheet1 Sheet2 Sheet3 Sheet4

1
vbaexcel
Why do you want or need to be able to change at both places? Isn't it better to just change at one of the places and use a simple formula to keep the sheets connected? – Andreas
Think it's a case of extending the code example you posted, probably better to use the Workbook SheetChange event which will save you having a different bit of code for each sheet. – SJR
If you manage to get what you want, won't that create an endless loop? You update "sheet1", the summary is automatically updated because of this, when the summary is updated the code notices it and updates "sheet1" again that again updates summary and so on. – Andreas
Fully agree that data entry in one place is the best design practice...however in this case I'm trying something different. – csaunders
You can turn off update events during a macro run though Application.EnableEvents = False – jamheadart

1 Answers

0
votes

Something like this is what you're looking for. Make sure to place the code in the ThisWorkbook code module.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim wsSummary As Worksheet
    Dim rSummaryTable As Range
    Dim rChanged As Range
    Dim ChangedCell As Range
    Dim wsTest As Worksheet

    Set wsSummary = ThisWorkbook.Sheets("Sheet1")   'Set to actual name of your Summary Sheet
    Set rSummaryTable = wsSummary.Range("A:C")      'Set to the actual columns you want to monitor in the Summary sheet

    Application.EnableEvents = False

    If Sh.Name = wsSummary.Name Then
        Set rChanged = Intersect(rSummaryTable, Target)
        If Not rChanged Is Nothing Then
            For Each ChangedCell In rChanged.Cells
                On Error Resume Next
                Set wsTest = ThisWorkbook.Sheets(ChangedCell.Row + 1)
                On Error GoTo 0
                If wsTest Is Nothing Then Set wsTest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsTest.Cells(1, ChangedCell.Column).Value = ChangedCell.Value
                wsSummary.Activate
            Next ChangedCell
        End If
    Else
        Set rChanged = Intersect(Sh.Range(rSummaryTable.Cells(1).Address).Resize(, rSummaryTable.Columns.Count), Target)
        If Not rChanged Is Nothing Then
            For Each ChangedCell In rChanged.Cells
                rSummaryTable.Cells(Sh.Index - 1, ChangedCell.Column - rSummaryTable.Column + 1).Value = ChangedCell.Value
            Next ChangedCell
        End If
    End If

    Application.EnableEvents = True

End Sub