Create cells mirroring each others

Jaberdino

New Member
Joined
Mar 19, 2014
Messages
10
Hi Huys,

Long time no see :)

Hope you are well!

I'm trying to write something some kind of a mirror between multiple cells.

Context: I have a dropdown of countries on five different sheets (the dropdown is the same on each sheet).
I want the user to be able to change the country on each sheet.
Of course, when the user change the country on one sheet, it should be changed on all other sheets.

So, I've been playing with the events, creating endless loops kind of crashing my excel.

For instance, in the basic case of two sheet. When inserting this for the sheet1:
Code:
Public Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = WorkSheets(1).Range("A1:A1")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing AND Activesheet.name="Sheet1" Then
        WorkSheets(2).Range("A1:A1").value=WorkSheets(1).Range("A1:A1").value
    End If
End Sub

and an equivalent code for sheet2, then I have "not enough resource to display completely".

I can't find a way to say "if the cell change and then change the cells on the other sheets IIF you are on the active sheet". So it doesn't create endless loop, I guess.

Thanks a lot for your help :)

Cheers,
Jaberdino
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Try this:-
Your Drop Down (validation List) in "A1" of each sheet.
NB:- This code needs to go in the "ThisWorkbook" Module :- See VBProject window on left of VB editer window
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sht As Worksheet
Application.EnableEvents = False
    If Target.Address(0, 0) = "A1" Then
        For Each Sht In Worksheets
            Sht.Range("A1") = Target
        Next Sht
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Code:
Option Explicit


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


' note: this code goes in the Workbook Class module


Dim ws As Worksheet
Dim KeyCells As Range
Set KeyCells = Range("A1")


If Target.Cells.Count > 1 Then Exit Sub
If Intersect(KeyCells, Target) Is Nothing Then Exit Sub
'If Target.Value = "" Then Exit Sub


Application.EnableEvents = False
For Each ws In Worksheets
    ws.Range("A1").Value = Target.Value
Next 'ws
Application.EnableEvents = True


End Sub
 
Upvote 0
You guys are amazing!

Always impressed by the speed :)

By the way, would you know how to restruct this action to certain sheet, eg not all my sheet will have this drop down.

Say, I only want to this to be activated on sheet "Dashboard1", "Dashboard2", etc. but not on "DATA1", "DATA2", etc. ?

Thanks again
 
Upvote 0
Try this:-
Add the sheets you want to Array
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sht As Variant
Application.EnableEvents = False
    If Target.Address(0, 0) = "A1" Then
        For Each Sht In Array("Dashboard1", "Dashboard2")
            Sheets(Sht).Range("A1") = Target
        Next Sht
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0
I think you need to check and include/exclude the sheets to be mirrored. This can be checked using sh.Name

Code:
Option Explicit


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


' note: this code goes in the Workbook Class module
' I only want to this to be activated on sheet "Dashboard1", "Dashboard2", etc. but not on "DATA1", "DATA2", etc.


Dim ws As Worksheet
Dim KeyCells As Range
Set KeyCells = Range("A1")
Const sSheets As String = "Dashboard1,Dashboard2,Dashboard3"


' check sheet is one of those to be mirrored
If InStr(sSheets, sh.Name) = 0 Then Exit Sub


' exclusions
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(KeyCells, Target) Is Nothing Then Exit Sub
'If Target.Value = "" Then Exit Sub


' make changes to mirrored sheets
Application.EnableEvents = False
For Each ws In Sheets(Split(sSheets, ","))
    ws.Range("A1").Value = Target.Value
Next 'ws
Application.EnableEvents = True


End Sub
 
Upvote 0
@MickG: I think, as it stands, your code will mirror changes made to cell A1 on ANY sheet but only update Dashboard1 and Dashboard2
 
Upvote 0
TMS , thanks for that:-
Here is an alternative
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sht As Variant
Application.EnableEvents = False
 If Target.Address(0, 0) = "A1" And Left(Target.Parent.Name, 9) = "Dashboard" Then
        For Each Sht In Array("Dashboard1", "Dashboard2")
            Sheets(Sht).Range("A1") = Target
        Next Sht
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0
@Mick: ditto ... and another variation on a theme:

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sht As Variant
Const sDB As String = "Dashboard"


Application.EnableEvents = False
 If Target.Address(0, 0) = "A1" And Left(Sh.Name, Len(sDB)) = sDB Then
        For Each Sht In Array(sDB & 1, sDB & 2)
            Sheets(Sht).Range("A1") = Target
        Next Sht
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Excellent, both working perfectly!


I didn't know about this
Target.Parent.Name

which is quite useful ha!

Thanks a lot, I'll play with this now ;)
</pre>
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top