Cell is equal to another cell until you write something in it

Great, this works for me, thank you very much for your help :friends:.

After using for a while program that I have build with huge help from this community I came with a idea how to ease things even more for me. But I need this code to work for more then two sheets. Is there easy way to integrate `const cSheet3, cSheet4 etc in code so that different cells from more than two Sheets reffer to same cells in Sheet 1. Dont know did I explain it good enough, simple I need this program to work with more then 2 Sheets and in Sheet1 will always be default values Something like:
Sheet1 A1= Sheet2 A3
Sheet3 B2
Sheet4 C3

Actually I figured out this on my own :cool:
I added one more Public const and one more Sub for sheet 3 in module

Code:

---

Option Explicit


Public Const cSheet1Match As String = "A1,A3,A5,A7,A14,"    '  need last comma
Public Const cSheet2Match As String = "B1,B3,B5,B7,B14,"    '  need last comma
Public Const cSheet3Match As String = "B1,B3,B5,B7,B14,"


Sub putSheet1OnSheet2(rSheet1 As Range)
    Dim rSheet2 As Range
    Dim rSheet3 As Range
   
    With rSheet1
        Set rSheet2 = Worksheets("Sheet2").Range(rSheet1.Address).Offset(0, 1)
        Set rSheet3 = Worksheets("Sheet3").Range(rSheet1.Address).Offset(0, 1)
        rSheet2.Value = .Value
        rSheet3.Value = .Value
    End With
End Sub


Sub getSheet2FromSheet1(rSheet2 As Range)
    Dim rSheet1 As Range
   
    With rSheet2
        Set rSheet1 = Worksheets("Sheet1").Range(rSheet2.Address).Offset(0, -1)
        .Value = rSheet1.Value
    End With
End Sub


Sub getSheet3FromSheet1(rSheet3 As Range)
    Dim rSheet1 As Range
   
    With rSheet3
        Set rSheet1 = Worksheets("Sheet1").Range(rSheet3.Address).Offset(0, -1)
        .Value = rSheet1.Value
    End With
End Sub

---

and then I just copied same code for Sheet 3

Code:

---

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rChanged As Range, rCell As Range
   
    'in case entire column selected
    Set rChanged = Intersect(Target.Parent.UsedRange, Target)
    If rChanged Is Nothing Then Exit Sub
       
    Application.EnableEvents = False
   
    For Each rCell In rChanged.Cells
        If InStr(cSheet3Match, rCell.Address(False, False) & ",") > 0 Then
            If Len(rCell.Value) = 0 Then Call getSheet3FromSheet1(rCell)
        End If
    Next
   
    Application.EnableEvents = True


End Sub

---

Is this good way to do it?Attachment 28202

Good job :clap:

Any way that works is a good way.

Oh, I have new problem now :crying: When I write "Public const" for Sheet1 they all copy to Sheet2, Sheet3 etc. but I dont need them all on every Sheet.
For example if I have fields "Name", "Age", "Gender", "Address" on Sheet1 and on Sheet2 I only need "Name" and "Age" and on Sheet3 I need "Gender" and "Address" this code force me to use all fields on every Sheet.

Code:

---

Public Const cSheet1Match As String = "A1,A3,A5,A7,A14,"    '  need last comma
Public Const cSheet2Match As String = "B1,B3,B5,B7,B14,"    '  need last comma
Public Const cSheet3Match As String = "B1,B3,B5,B7,B14,

---

Even if I delete cell names in Public Const cSheet2Match and Public Const cSheet3Match they will be shown on Sheet2 and Sheet3.
I figured this while implementing your code and its very frustrating for me because I have no idea how to fix it. Any help :help

Try this version

This works but there is still that one huge problem that make this whole code useless for me. If I have cell "Name" on Sheet1 and its located in A1 the code will put it in A1 on Sheet 2 and only thing I can do is to modify offset. But then if I modify offset by 1 everything will be in column B and I need some thing in column "C" etc. So that doesnt work for me because fields on different sheets are not located at the same place and in the same order. Maybe I ask to much now but is there any other way to rearrange cells not with offset :think:

Quote:

---

Originally Posted by hrzagi

This works but there is still that one huge problem that make this whole code useless for me. If I have cell "Name" on Sheet1 and its located in A1 the code will put it in A1 on Sheet 2 and only thing I can do is to modify offset. But then if I modify offset by 1 everything will be in column B and I need some thing in column "C" etc. So that doesnt work for me because fields on different sheets are not located at the same place and in the same order. Maybe I ask to much now but is there any other way to rearrange cells not with offset :think:

---

I'm sorry it's useless for you

It would have been helpful to know that instead of your examples (Sheet1 A1 paired with Sheet2 B2), you really wanted a completely general purpose approach

I'll try to look at it later


Edit:


Lot more maintenance to configure and maintain. More hard codng that I like, but some could be replaced with a 'table' on a hidden sheet, or by using module code names


Standard Module

Code:

---

Option Explicit


Public aryPair(1 To 4, 1 To 2) As Range
Public ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet


'called in Thisworkbook Open
Sub Init()
   
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")


    Set aryPair(1, 1) = ws1.Range("A1")
    Set aryPair(1, 2) = ws2.Range("B1")


    Set aryPair(2, 1) = ws1.Range("A3")
    Set aryPair(2, 2) = ws2.Range("B3")


    Set aryPair(3, 1) = ws1.Range("A5")
    Set aryPair(3, 2) = ws3.Range("C2")


    Set aryPair(4, 1) = ws1.Range("A7")
    Set aryPair(4, 2) = ws3.Range("D2")
   
End Sub




Function SameCell(r1 As Range, r2 As Range) As Boolean
    SameCell = False
   
    If r1.Parent.Name <> r2.Parent.Name Then Exit Function
    If r1.Address <> r2.Address Then Exit Function
   
    SameCell = True
End Function

---

ThisWorkbook module

Code:

---

Option Explicit

Private Sub Workbook_Open()
    Init
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rCell As Range
    Dim i As Long
       
    Application.EnableEvents = False
   
    If Target.Rows.Count = Target.Parent.Rows.Count Or Target.Columns.Count = Target.Parent.Columns.Count Then
        Application.EnableEvents = True
        Exit Sub
    End If
           
    Select Case Sh.Name
        Case "Sheet1"
            For Each rCell In Target.Cells
                For i = LBound(aryPair, 1) To UBound(aryPair, 1)
                    If SameCell(rCell, aryPair(i, 1)) Then
                        If Len(aryPair(i, 2).Value) = 0 Then
                            aryPair(i, 2).Value = aryPair(i, 1).Value
                            Exit For
                        End If
                    End If
                Next i
            Next
       
        Case "Sheet2", "Sheet3"
            For Each rCell In Target.Cells
                For i = LBound(aryPair, 1) To UBound(aryPair, 1)
                    If SameCell(rCell, aryPair(i, 2)) Then
                        If Len(aryPair(i, 2).Value) = 0 Then
                            aryPair(i, 2).Value = aryPair(i, 1).Value
                            Exit For
                        End If
                    End If
                Next i
            Next
       
    End Select
   
    Application.EnableEvents = True


End Sub




Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim rCell As Range
    Dim i As Long


    Application.EnableEvents = False
   
    Select Case Sh.Name
        Case "Sheet2", "Sheet3"
            For i = LBound(aryPair, 1) To UBound(aryPair, 1)
                If Len(aryPair(i, 2).Value) = 0 Then
                    aryPair(i, 2).Value = aryPair(i, 1).Value
                    Exit For
                End If
            Next i
        End Select
   
    Application.EnableEvents = True


End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

I'm sorry it's useless for you

It would have been helpful to know that instead of your examples (Sheet1 A1 paired with Sheet2 B2), you really wanted a completely general purpose approach

I'll try to look at it later

---

Sorry, I didnt explain enough because of my bad english. I should upload example so its easier to understand. I will upload it. Thanks for all your help, it will make things much easier for me on job once its finished.

Quote:

---

Originally Posted by hrzagi

Sorry, I didnt explain enough because of my bad english. I should upload example so its easier to understand. I will upload it. Thanks for all your help, it will make things much easier for me on job once its finished.

---

Check out the edit in post #28

Sub Init() and aryPair() must be updated and customized

If the concept is OK with your, I'll take a shot at your example

I dont get it how i choose cells, tried to change aryPair but nothing happens :think:
This is example of program that I need and I supposed to upload it at the beginning. I didnt upolad original program because it has 16 modules and too much fields so it would be confusing to work with it but if this version would work I can easily apply code to original program.

The pairing is configured in the sub Init() by by entering pairs of cells

Code:

---

Option Explicit


Public aryPair(1 To 6, 1 To 2) As Range
Public ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Public rName As Range, rTown As Range, rOrder As Range, rPart As Range


'called in Thisworkbook Open
Sub Init()
   
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")
   
    Set rName = ws1.Range("D3")    '  name
    Set rTown = ws1.Range("H3")    '  town
    Set rOrder = ws1.Range("D6")    '  order
    Set rPart = ws1.Range("H6")    '  part
   
   
    '------------------------------------------------------------ Sheet1 to Sheet2 / Sheet2 to Sheet1
    Set aryPair(1, 1) = rName
    Set aryPair(1, 2) = ws2.Range("E2")


    Set aryPair(2, 1) = rTown
    Set aryPair(2, 2) = ws2.Range("E5")


    Set aryPair(3, 1) = rOrder
    Set aryPair(3, 2) = ws2.Range("I2")
   
    '------------------------------------------------------------ Sheet1 to Sheet3 / Sheet3 to Sheet1
    Set aryPair(4, 1) = rPart
    Set aryPair(4, 2) = ws3.Range("F2")


    Set aryPair(5, 1) = rTown
    Set aryPair(5, 2) = ws3.Range("F5")


    Set aryPair(6, 1) = rOrder
    Set aryPair(6, 2) = ws3.Range("F7")


    Application.EnableEvents = True
   
End Sub

---

Ok this works except now it doesnt update until I delete old value in cells on Sheet2 nad Sheet 3. In previuos version cells would update Sheet2 and Sheet3 no matter are they empty or populated.

Quote:

---

Originally Posted by Paul_Hossler

Seems to work for me


Start: Sheet1 Name = Bill and Sheet2 Name = Bill

Change Sheet2 Name to Tom

Now: Sheet1 Name = Bill and Sheet2 Name = Tom

Delete Sheet2 Name

Now: Sheet1 Name = Bill and Sheet2 Name = Bill

---

For me its like,
Start: Sheet1=Empty
Sheet2=Empty

First change: Sheet1=Bill
Sheet2=Bill

Second change: Sheet1=Tom
Sheet2=Bill (and it stays Bill no matter what I write in Sheet1 until I delete Bill from cell)

All previous versions of code in this thread would change to Tom or whatever I write in Sheet1 no matter if cell is empty or not on Sheet2. I will try on another computer at work with different version of Office, maybe it will work for me if it work for you :dunno

Two line change

Quote:

---

Originally Posted by Paul_Hossler

Two line change

---

Oh, its seems that finnaly works perfect for me but i said that few times in this thread so :rofl: I will try to implement it tommorow and then will review it. Thank you very much for all your effort :clap:

:thumb

Quote:

---

Originally Posted by Paul_Hossler

The pairing is configured in the sub Init() by by entering pairs of cells

---

Could you explain it for dummies :( It seems whatever i change in

Code:

---

Set aryPair(1, 1) = rName    Set aryPair(1, 2) = ws2.Range("E2")

---

the name will stay in E2

These are the important pieces

1. aryPair (...) is a Nx2 array with the first element being the 'from' and the second being the 'to'

2. The named range 'rName' is set to Sheet1, D3. Same for the other key Sheet1 fields

3. Sheet1, D3 is paired with Sheet2, E2 in aryPair(1,..)
If Sheet1, D3 is updated then Sheet2, E2 is updated
If Sheet2, E2 is blank then Sheet1, D3 is used

4. Sheet1, H6 is paired with Sheet3, F2 in aryPair (4, ...)
If Sheet1, H6 is updated then Sheet3, F2 is updated
If Sheet3, F2 is blank then Sheet1, H6 is used

5. The WS Change event has a Select Case to handle Sheet1 changes vs Sheet2 and 3 changes

Code:

---

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

---

Code:

---


Public aryPair(1 To 6, 1 To 2) As Range
Public ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Public rName As Range, rTown As Range, rOrder As Range, rPart As Range


'called in Thisworkbook Open
Sub Init()
   
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")
   
    Set rName = ws1.Range("D3")    '  name
    Set rTown = ws1.Range("H3")    '  town
    Set rOrder = ws1.Range("D6")    '  order
    Set rPart = ws1.Range("H6")    '  part
   
   
    '------------------------------------------------------------ Sheet1 to Sheet2 / Sheet2 to Sheet1
    Set aryPair(1, 1) = rName
    Set aryPair(1, 2) = ws2.Range("E2")


    Set aryPair(2, 1) = rTown
    Set aryPair(2, 2) = ws2.Range("E5")


    Set aryPair(3, 1) = rOrder
    Set aryPair(3, 2) = ws2.Range("I2")
   
    '------------------------------------------------------------ Sheet1 to Sheet3 / Sheet3 to Sheet1
    Set aryPair(4, 1) = rPart
    Set aryPair(4, 2) = ws3.Range("F2")


    Set aryPair(5, 1) = rTown
    Set aryPair(5, 2) = ws3.Range("F5")


    Set aryPair(6, 1) = rOrder
    Set aryPair(6, 2) = ws3.Range("F7")


    Application.EnableEvents = True
   
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

These are the important pieces

---

I know Im quite annoying now but I really tried my best to understand and google it for answer before I came back here cause I just cant get it or visualize it. I also tried changing things in

Code:

---

Set aryPair(1, 1) = rName
  Set aryPair(1, 2) = ws2.Range("E2")

---

but whatever I do the cells will pair with E2 or I will get error. I just cant get it to pair with K2, L8 or any other cell and now Im pretty desperate because this work great but I dont know the way how to integrate it in my program.
I understand this are the cells where default value is

Code:

---

Set rName = ws1.Range("D3")    '  name
    Set rTown = ws1.Range("H3")    '  town
    Set rOrder = ws1.Range("D6")    '  order
    Set rPart = ws1.Range("H6")    '  part

---

and this is their pair

Code:

---

  Set aryPair(1, 1) = rName
  Set aryPair(1, 2) = ws2.Range("E2")

---

but I cant figure out how to change the original cells and their pair where values go. I was thinking if I change values in bracket that will change position but that doesnt work or Im doing something wrong. Is there any simple way to explain me how I change code if I want for example to copy from Sheet1 "C5" to Sheet2 "L10".