csaunders
csaunders

Reputation: 15

Sync Multipe Worksheets

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

Upvotes: 1

Views: 1063

Answers (1)

tigeravatar
tigeravatar

Reputation: 26660

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

Upvotes: 0

Related Questions