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

[hrzagi]

I need help with this and I think VBA is the way to go but I'm not sure. I will try to simplify. If cell A1 on Sheet1 has some value cell B1 on Sheet2 should show the same value and that is easy to do with equal formula. But when I want to change value on cell B1 I dont want to erase formula every time and type it back when I need it. So cell B1 should be equal to A1 so long until I write something in it. And if I delete value the cell go back on A1 value. Does anyone have idea how to do it?

[Paul_Hossler]

In Sheet2's code module




Option Explicit


Private Sub Worksheet_Activate()
With Me.Range("B1")
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
End With


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$B$1" Then Exit Sub

If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
End With
End Sub

[hrzagi]

Thank you for fast response. This works nice but it doesnt refresh automatically. Let me explain, If I write Bob in cell A1 and cell B1 is empty then cell B1 will become equal to A1. This part work fine. But if I make new change in cell A1 and write Karl, value in cell B1 will stay Bob because It wasnt empty and for my little program its important to change it to Karl. Dont know did I explain it good. I need it to changes in A1 always change value in B1 but from there I could make changes in B1 and that will do nothing to value in A1 and if I give up and delete everything in B1 default value will again be equal to A1.

[SamT]

Sheet1 A1 : Sheet2 B1. If one changes, check the other. No formulas in B1.

Sheet1 code
Option Explicit

Private Sub Worksheet_Calculate()
'Necessary with Formulas in A1
CheckB1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then CheckB1 'A1 changed
End Sub

Private Sub CheckB1()
If Sheet2.Range("B1") = "" Then Sheet2.Range("B1") = Range("A1")
End Sub

Sheet2 Code
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then CheckA1 'B1 changed
End Sub

Private Sub CheckA1()
If Range("B1") = "" Then Range(" B1") = Sheet2.Range("A1")
End Sub

[hrzagi]

SamT I get run time error "28" Out of stack space with this code :dunno

[SamT]

Hunh?!?! Where? What are you doing when it happens?

The only "Stacking" in there is Worksheet_Change(ByVal Target As Range)

[hrzagi]

Hunh?!?! Where? What are you doing when it happens?

The only "Stacking" in there is Worksheet_Change(ByVal Target As Range)

Hm, nothing really, I put value in A1 and nothing happen in B1 and when I put value in B1 and delete it again I got error. Does it work for you? Could you attach sample file, Im newbie in VBA so maybe Im doing some silly mistake :dunno

[Paul_Hossler]

Put this in the code module for Sheet1




Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$A$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) > 0 Then Worksheets("Sheet2").Range("B1").Value = .Value
Application.EnableEvents = True


End Sub




and this in for Sheet2



Option Explicit


Private Sub Worksheet_Activate()
With Me.Range("B1")
Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$B$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With
End Sub

[Paul_Hossler]

Hunh?!?! Where? What are you doing when it happens?

The only "Stacking" in there is Worksheet_Change(ByVal Target As Range)

Usually means that Application.EnableEvents was not disabled and the _Change event kept calling itself

[SamT]

Usually means that Application.EnableEvents was not disabled and the _Change event kept calling itself
Yep, Probably what's happening.

Sheet1 code:
Option Explicit

Private Sub Worksheet_Calculate()
'Necessary with Formulas in A1
CheckB1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.enableEvents = False
If Not Intersect(Target, Range("A1")) Is Nothing Then CheckB1 'A1 changed
Application.enableEvents = True
End Sub

Private Sub CheckB1()
If Sheet2.Range("B1") = "" Then Sheet2.Range("B1") = Range("A1")
End Sub
Sheet2 code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.enableEvents = False
If Not Intersect(Target, Range("B1")) Is Nothing Then CheckA1 'B1 changed
Application.enableEvents = True
End Sub

Private Sub CheckA1()
If Range("B1") = "" Then Range(" B1") = Sheet2.Range("A1")
End Sub


BTW, with With Target.Cells(1, 1), What happens when Range("A1:C1") = Range("A2:C2")

That's why I like If Not Intersect(Target, Range("blah")) Is Nothing

[hrzagi]

Put this in the code module for Sheet1




Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$A$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) > 0 Then Worksheets("Sheet2").Range("B1").Value = .Value
Application.EnableEvents = True


End Sub




and this in for Sheet2



Option Explicit


Private Sub Worksheet_Activate()
With Me.Range("B1")
Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$B$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With
End Sub




Works like a charm :thumb One little error, you missed end with on sheet one code. Thank you very much sir :clap:

[Paul_Hossler]

One little error, you missed end with on sheet one code.


When I was pasting in EnableEvents lines, I must have replaced the End With instead of inserting above

Glad you fixed it

[Paul_Hossler]

Yep, Probably what's happening.

BTW, with With Target.Cells(1, 1), What happens when Range("A1:C1") = Range("A2:C2")

That's why I like If Not Intersect(Target, Range("blah")) Is Nothing

Probably habit

My thinking is that (as you say) multiple cells might be selected, but I wanted to ensure that I'm acting on the one that I think I want to, so I test for the first cell in Target

If Target was A1:C1 (3 cells changed), then Target.Cells(1,1) = A1

If Target was A2:C2 (3 cells changed), then Target.Cells(1,1) = A2 so Exit Sub

If Target was D10:F20 (33 cells changed) AND the desired action was to update (for ex) column G10:G20 with 2 x D10:D20, I'd use your way

Again, just habit and personal preference.

I'm not worried -- I'm sure someone here will tell me why it's wrong so maybe I'll learn some thing :rotlaugh:

[SamT]

Sub T()
Dim X
X = Array(1,2,3,4,5)
Range("Blah").Resize(1, 5) = X
End Sub

Write Worksheet Change code to do something if C1 has changed after running sub T that will every possible value of Blah

[Paul_Hossler]

Not sure I followed it all

Blah is Named Range A1:E1

Sub T() puts 1,2,3,4,5 into A1:E1



Option Explicit


Sub T()
Dim X As Variant

X = Array(1, 2, 3, 4, 5)

Application.EnableEvents = False
Range("Blah").Resize(1, 5) = X
Application.EnableEvents = True


End Sub





Changing anything in A1:E1 doubles the 5 values




Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
If Intersect([Blah], Target) Is Nothing Then Exit Sub

Application.EnableEvents = False
For Each r In [Blah].Cells
r.Value = 2 * r.Value
Next
Application.EnableEvents = True
End Sub

[hrzagi]

Put this in the code module for Sheet1




Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$A$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) > 0 Then Worksheets("Sheet2").Range("B1").Value = .Value
Application.EnableEvents = True


End Sub




and this in for Sheet2



Option Explicit


Private Sub Worksheet_Activate()
With Me.Range("B1")
Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1, 1)
If .Address <> "$B$1" Then Exit Sub

Application.EnableEvents = False
If Len(.Value) = 0 Then .Value = Worksheets("Sheet1").Range("A1").Value
Application.EnableEvents = True
End With
End Sub




Could you please explain me how to modify the code for multiple cells on Sheet1 with corresponding cells on Sheet2. Something like A1=B1, A3=B3, A5=B5 etc. Or I need to write whole code for every cell seperately?

[SamT]

:devil2:

[Paul_Hossler]

This does any cell in Col A on Sheet1 and the same row Col B on Sheet2

If you don't want any Col A cell, then you'll need to be more specific


Sheet1



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rChanged As Range, rArea As Range, rCell As Range

'get changed cells in column A
Set rChanged = Intersect(Target, Me.Columns(1))
If rChanged Is Nothing Then Exit Sub

Set rChanged = Intersect(Target.Parent.UsedRange, rChanged)

Application.EnableEvents = False

'handle multi-selection, discontigious changed
For Each rArea In rChanged.Areas
For Each rCell In rArea.Cells
Call putSheet1OnSheet2(rCell)
Next
Next

Application.EnableEvents = True


End Sub



Sheet2



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rChanged As Range, rArea As Range, rCell As Range

'get changed cells in column B
Set rChanged = Intersect(Target, Me.Columns(2))
If rChanged Is Nothing Then Exit Sub

Set rChanged = Intersect(Target.Parent.UsedRange, rChanged)

Application.EnableEvents = False

'handle multi-selection, discontigious changed
For Each rArea In rChanged.Areas
For Each rCell In rArea.Cells
If Len(rCell.Value) = 0 Then Call getSheet2FromSheet1(rCell)
Next
Next

Application.EnableEvents = True
End Sub




Standard module



Option Explicit


Sub putSheet1OnSheet2(rSheet1 As Range)
Dim rSheet2 As Range

With rSheet1
Set rSheet2 = Worksheets("Sheet2").Range(rSheet1.Address).Offset(0, 1)
rSheet2.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




Edit - slightly more robust version

[hrzagi]

Sorry, I didnt explain enough. I dont want whole column to match. What I need is specific cells like Sheet1 A1= Sheet2 B1, Sheet1 B3= Sheet 2 A3 and so on if you understand. I would define matching cells but I dont want whole columns to match.

[Paul_Hossler]

Try this version then

The 2 Const are in the standard module and are the cells to check
This seemed the easiest and most maintainable way



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


Sub putSheet1OnSheet2(rSheet1 As Range)
Dim rSheet2 As Range

With rSheet1
Set rSheet2 = Worksheets("Sheet2").Range(rSheet1.Address).Offset(0, 1)
rSheet2.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

[hrzagi]

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

[hrzagi]

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

[hrzagi]

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

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



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?28202

[SamT]

Good job :clap:

Any way that works is a good way.

[hrzagi]

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.


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

[Paul_Hossler]

Try this version

[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:

[Paul_Hossler]

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



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



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

[hrzagi]

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.

[Paul_Hossler]

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

[hrzagi]

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.

[Paul_Hossler]

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




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

[hrzagi]

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.

[hrzagi]

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

[Paul_Hossler]

Two line change

[hrzagi]

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:

[Paul_Hossler]

:thumb

[hrzagi]

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
Set aryPair(1, 1) = rName Set aryPair(1, 2) = ws2.Range("E2") the name will stay in E2

[Paul_Hossler]

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




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






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

[hrzagi]

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
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

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

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".

[Paul_Hossler]

I added a field that is paired with fields on both Sheet2 and Sheet3

The aryPair() rows has to be dimensioned to hold the pairs (was 6 not it's 8)

It holds Ranges so aryPair (7,1) and aryPair (7,2) have to be Set,



Set aryPair(7, 1) = ws1.Range("F10")
Set aryPair(7, 2) = ws2.Range("E12")


The pairs can be Set in any order in the aryPair array


28217


It's necessary somehow to 'link' pairs of cells between sheets so that they can be updated

The Workbook_SheetChange event uses aryPair() pairs and the sheet that was changed (Sheet1 or Sheet2/Sheet3)) to see if something needs to be updated


I can do some code polishing that might make it a little more straight forward if you want
If you do, then please attach a SMALL realistic sample of real data




Option Explicit


Public aryPair(1 To 8, 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")

Set aryPair(7, 1) = ws1.Range("F10") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Set aryPair(7, 2) = ws2.Range("E12") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<



'------------------------------------------------------------ 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")


Set aryPair(8, 1) = ws1.Range("F10") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Set aryPair(8, 2) = ws3.Range("J11") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


Application.EnableEvents = True

End Sub

[hrzagi]

But how do you count it, what (7,1) and (7,2) mean in

Set aryPair(7, 1) = ws1.Range("F10")
Set aryPair(7, 2) = ws2.Range("E12")
How (7,2) refer to cell E12? E12 is column 6 and row 10 :think:
and what (1 to 8, 1 to 2) mean in

Public aryPair(1 To 8, 1 To 2) As Range
Is that some table that I dont see?
I think it would be much easier fot me to understand if I know how you count it.

[Paul_Hossler]

Read about arrays

http://www.snb-vba.eu/VBA_Arrays_en.html

That's what aryPair is



There's really no counting, except for knowing how many pairs of cells are linked (8 in the latest example)

If there are more than 8, then the dimensions for aryPair needs to be updated

The aryPair (x, y) have NOTHING to do with the cell location, address, row, column, or value

The 'x' is a pair counter (1 to 8), and the 'y' (1 to 2) is the two cells that are linked

The linked cells are Set (since aryPair is storing Ranges) so that the Worksheet_Change logic knows what to check

So the 7th pair entry links these two cells on Sheet1 and Sheet2



Set aryPair(7, 1) = ws1.Range("F10")
Set aryPair(7, 2) = ws2.Range("E12")

[hrzagi]

Finally I get it and I managed to add more pairs :cool: Its not so complicated once I figured out how it works. Thank you very much for all your help and patience :bow:

[Paul_Hossler]

Glad you got it -- it's a little compliated because of the logic you wanted

There is a little bit that can be added to possibly simplify it a little more if you want

[hrzagi]

There is a little bit that can be added to possibly simplify it a little more if you want

If it is not broken dont fix it :rofl:

[Paul_Hossler]

If it is not broken, don't fix it :rofl:

Words to the wise

[hrzagi]

Code works fine 99% time but sometimes "I get error Run-time error 91
Object variable or With block not set " and when I go to debug the problem seems to be in this line of code


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


The problem occur after I enter text in first cell of pair and then when I click on other sheet. And if I exit excell and run it again, everything works fine. Do you know what it could be?

[hrzagi]

Actually now I see that problem sometimes occur even if I dont write anything but just change sheets :think:

[Paul_Hossler]

I could not get it to fail, but I'm not sure I was exactly copying your steps

Comment out or remove the marked line in the sub below and see if that fixes it




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





If that doesn't resolve the issue, then let me have all of the steps you do to get it to fail

[hrzagi]

Ok, I tried this and its working for now but I will test it for few days. Also if it fail I will try to figure out what have I done before it failed because for now its seems like it occur randomly.