Copy cell value via VBA if specific cell is changed

[Schturman]

Hi to all
I need some help to change the code that I use to copy value...
This code I use:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

 If Not Intersect(Target, Range("B2")) Is Nothing Then
  Set rng = Range("C2")
  rng.Value = Range("A2")
    Else
    If Not Intersect(Target, Range("B3")) Is Nothing Then
     Set rng = Range("C3")
     rng.Value = Range("A2")
     End If
  End If

End Sub

If I do any changes to B2, it will copy A2 to C2
If I do any changes to B3, it will copy A2 to C3
And so on...

When I add new row (for example insert value to B4), I need to update my code that will do the same copy to C4
Can someone help me to change the code that will do what I want without every time updating VBA code ?
Thanks

 

[Micron]

Try on a sheet copy

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

Application.EnableEvents = False
 If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Set rng = Target.Offset(0, 1)
    rng = Target.Offset(0, -1)
End If
Application.EnableEvents = True

End Sub

I usually advocate using an error handler when altering application settings though, lest they remain off.

 

[Joe4]

Note that there really isn't any reason to set a range variable in this case.

You can simply combine these two lines:

    Set rng = Target.Offset(0, 1)
    rng = Target.Offset(0, -1)

to just this:

    Target.Offset(0, 1) = Target.Offset(0, -1)

 

[Schturman]

Thanks to both of you, but it not copy value of A2 to Column C... See image, I added 66 to B4 and nothing happens...

 

[Micron]

I missed that A2 was a constant. Try

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Not Intersect(Target, Range("B:B")) Is Nothing Then Target.Offset(0, 1) = Range("A2")
Application.EnableEvents = True

End Sub

 

[Schturman]

I missed that A2 was a constant. Try

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Not Intersect(Target, Range("B:B")) Is Nothing Then Target.Offset(0, 1) = Range("A2")
Application.EnableEvents = True

End Sub

Yep, already tried this, but still not copying..

 

[Micron]

Works for me. Post your new code? You put a breakpoint on the code, ran it and stepped through to make sure it's running? I suspect you ended up with Events disabled as I mentioned. I'll revise that code to include an error handler.

 

[Micron]

First put this in the immediate window and hit enter at the end of the line
Application.EnableEvents = True

Then try this version:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo errHandler

'avoid error if user selects & deletes multiple rows
If Target.Columns.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Application.EnableEvents = False
    Target.Offset(0, 1) = Range("A2")
End If

exitHere:
Application.EnableEvents = True
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub

 

[Schturman]

Ohhh, probably my mistake... I saved and close the file. Now opened it again and it work perfectly
Thank you !!!

I thought about something, instead to get value of A2 in the column C, can I get A2 * cell in column B that I change.
When I changed your code to this:

Target.Offset(0, 1) = Range("A2") * Target.Offset(0, 1)

It work if I do changes to already existed cells, for example B3, B4... But If I add new line in the table (B5) I get result: 0.0000

Can you help with this too ?
Thanks

 

[Micron]

Target.Address is the cell address of the cell in column B that you edit. If you offset(0,1) you are referencing a cell in the same row, one cell to the right of B, which is empty. Do you see the solution?









Multiply by the Target.Value, not the offset.
Target.Offset(0, 1) = Range("A2") * Target.Value