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

[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

[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 One little error, you missed end with on sheet one code. Thank you very much sir

[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 D1020, 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

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

[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