View Full Version : [SOLVED:] Cell is equal to another cell until you write something in it
hrzagi
03-25-2021, 05:30 AM
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
03-25-2021, 07:09 AM
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
03-25-2021, 07:29 AM
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.
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
03-25-2021, 10:34 AM
SamT I get run time error "28" Out of stack space with this code :dunno
Hunh?!?! Where? What are you doing when it happens?
The only "Stacking" in there is Worksheet_Change(ByVal Target As Range)
hrzagi
03-25-2021, 11:50 AM
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
03-25-2021, 12:12 PM
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
03-25-2021, 12:17 PM
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
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
03-25-2021, 12:47 PM
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
03-25-2021, 02:02 PM
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
03-25-2021, 02:16 PM
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:
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
03-25-2021, 03:11 PM
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
03-26-2021, 12:48 AM
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?
Paul_Hossler
03-26-2021, 08:19 AM
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
03-26-2021, 08:54 AM
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
03-26-2021, 09:34 AM
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
03-26-2021, 10:19 AM
Great, this works for me, thank you very much for your help :friends:.
hrzagi
03-27-2021, 02:51 AM
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
03-27-2021, 03:00 AM
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
Good job :clap:
Any way that works is a good way.
hrzagi
03-27-2021, 04:32 PM
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
03-27-2021, 05:47 PM
Try this version
hrzagi
03-27-2021, 06:13 PM
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
03-28-2021, 06:01 AM
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
03-28-2021, 06:24 AM
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
03-28-2021, 06:50 AM
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
03-28-2021, 09:08 AM
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
03-28-2021, 09:41 AM
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
03-28-2021, 10:35 AM
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
03-28-2021, 12:31 PM
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
03-28-2021, 12:31 PM
Two line change
hrzagi
03-28-2021, 12:44 PM
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
03-28-2021, 01:04 PM
:thumb
hrzagi
03-28-2021, 11:06 PM
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
03-29-2021, 05:04 AM
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
03-30-2021, 05:08 AM
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
03-30-2021, 06:41 AM
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
03-30-2021, 07:08 AM
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
03-30-2021, 07:42 AM
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
03-30-2021, 09:26 AM
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
03-30-2021, 10:03 AM
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
03-30-2021, 10:18 AM
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
03-30-2021, 12:08 PM
If it is not broken, don't fix it :rofl:
Words to the wise
hrzagi
04-01-2021, 01:58 AM
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
04-01-2021, 02:14 AM
Actually now I see that problem sometimes occur even if I dont write anything but just change sheets :think:
Paul_Hossler
04-01-2021, 07:14 AM
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
04-02-2021, 01:32 AM
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.