Sync Same Cell Across Multiple Sheets

DougDodge
DougDodge used Ask the Experts™
on
I am trying to figure out a way to Sync the same cell across multiple worksheets in excel.  It must allow a change to be made on any of the sheets, and then sync the other sheets to its value.  The VBA code that I am working with is posted and is supposed to work, but I am finding it difficult to work with.  The cell is A2 on all sheets, and the names of the sheets will probably change over time, so referencing the number would probably work the best.

I have attached the code snippet I am working with, which I found courtesy of JWalker.

Any clues as to how to make this work would be appreciated, and a working example would be fantastic.
Sub SynchSheets()
'   Duplicates the active sheet's active cell upperleft cell
'   Across all worksheets
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    Dim UserSheet As Worksheet, sht As Worksheet
    Dim TopRow As Long, LeftCol As Integer
    Dim UserSel As String
    
    Application.ScreenUpdating = False
 
'   Remember the current sheet
    Set UserSheet = ActiveSheet
    
'   Store info from the active sheet
    TopRow = ActiveWindow.ScrollRow
    LeftCol = ActiveWindow.ScrollColumn
    UserSel = ActiveWindow.RangeSelection.Address
    
'   Loop through the worksheets
    For Each sht In ActiveWorkbook.Worksheets
        If sht.Visible Then 'skip hidden sheets
            sht.Activate
            Range(UserSel).Select
            ActiveWindow.ScrollRow = TopRow
            ActiveWindow.ScrollColumn = LeftCol
        End If
    Next sht
    
'   Restore the original position
    UserSheet.Activate
    Application.ScreenUpdating = True
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
byundtMechanical Engineer
Most Valuable Expert 2013
Top Expert 2013

Commented:
The following sub will synch cell A2 across all worksheets in the workbook. It must be installed in the ThisWorkbook code module, and won't work at all if installed anywhere else.

To install a sub in the code pane for ThisWorkbook:
1) ALT + F11 to open the VBA Editor
2) If you don't see a list of VBA projects on the left, then CTRL + R to open the Project Explorer
3) In the Project Explorer window, double-click ThisWorkbook to open its code pane
4) Paste the suggested code in the resulting module sheet
5) ALT + F11 to return to the spreadsheet

If the above procedure doesn't work, then you need to change your macro security setting. To do so, open the Tools...Macro...Security menu item. Choose Medium, then click OK.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cel As Range
Set cel = Sh.[A2]   'Watch cell A2 on all worksheets for changes
If Intersect(Target, cel) Is Nothing Then Exit Sub
Application.EnableEvents = False
Me.Sheets.FillAcrossSheets cel
Application.EnableEvents = True
End Sub

Open in new window

Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
Commented:
DougDodge,
I probably should have used the Worksheets collection in my previous sub, in case you or your user puts a chart sheet in the workbook. Change line 6 to:
Me.Worksheets.FillAcrossSheets cel


If you want to exclude certain worksheets from the synchronization, matters get a little more complex. Rather than use the tab name or index, you'll have better luck using the code name of the worksheets. This is what you see in the Project Explorer. You can set it using the Properties pane--but the user cannot change it. Nor is it affected by shuffling the sheets in a different order. In the Project Explorer, you'll see the worksheet names listed like this:
WorksheetCodeName (Tab Name as set by User)

The snippet below excludes worksheets with code name Sheet2 and Sheet4 from the synchronization. Changes to those two worksheets are ignored as well.

Brad


<< http:/Q_24350421.html is a related question dealing with merged cell ranges and filling across sheets. In that thread, I learned that you must use cel.MergeArea when filling across sheets. byundt--4-24-09>>
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cel As Range
Dim ws As Worksheet
Dim wss As Sheets
Set cel = Sh.[A2]   'Watch cell A2 on all worksheets for changes
If Intersect(Target, cel) Is Nothing Then Exit Sub
For Each ws In Me.Worksheets
    Select Case ws.CodeName
    Case "Sheet2", "Sheet4" 'Don't include these worksheets in the synchronization
        If Sh.CodeName = ws.CodeName Then Exit Sub
    Case Else
        If ws.CodeName <> Sh.CodeName Then ws.Select Replace:=False    'Add worksheet to selected sheets 
    End Select
Next
Set wss = ActiveWindow.SelectedSheets
Application.EnableEvents = False
wss.FillAcrossSheets cel    'If cel is part of a merged cell range then use cel.MergeArea instead
Sh.Select Replace:= True    'Ungroup the worksheets
Application.EnableEvents = True
End Sub

Open in new window

Author

Commented:
Thank you for the quick reply.  I have tried the code, but now see the problem is in how I was updating the cell A2.  I use a popup calendar to populate the cell, this does not trigger the code as it does not recognize it as a cell change.  Is there a way to modify the code to accomodate this issue?

Author

Commented:
I saved the filed and closed it, and re-opened it.  The code you developed and sent works just fine now.  Thank you.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial