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

 

[Joe4]

@Joe4, thanks for continuing to educate. I didn't know about that property.
Not being an Excel expert I'm going to say that you're going to have to loop over the selected cells if you want to drag values down, then validate that each cell value is a number and if not, don't multiply.

We can loop through a multi-cell Target range. I am first just trying to get an understanding of what certain parts of his code currently do (or are supposed to do), because that line looks very strange to me.

 

[Schturman]

What is the point of this line here?

If Target = Target.Text Then

What are you trying to accomplish with that?

Look the next lines, it use:

Target.Offset(0, 1) = ""

Because if I write text instead number, without this line it try to use:

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

And I get error of code, because it can't calculate.
See the full code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Avoid error if user selects & deletes multiple rows
If Target.CountLarge > 1 Then Exit Sub

 If Not Intersect(Target, Range("B:B")) Is Nothing Then
  
   If Target = Target.Text Then
   Application.EnableEvents = False
   Target.Offset(0, 1) = ""
   Else
   Application.EnableEvents = False
   Target.Offset(0, 1) = Range("A2") * Target
   End If
  
 End If
 Application.EnableEvents = True 'error handle

End Sub

It used to detect text and not calculate. And this is a reason that I asked about more elegant way

 

[Joe4]

OK, I went back and re-read everything carefully, and I think I see what you are after.
I think the following code should do what you want, even dragging down multiple cells at once:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range

'   See if any cells updated in column B
    Set rng = Intersect(Target, Range("B:B"))
    If rng Is Nothing Then Exit Sub
    
'   Loop though all updated rows in column B
    For Each cell In rng
        If IsNumeric(cell.Value) Then
            Application.EnableEvents = False
            cell.Offset(0, 1) = Range("A2") * cell
        Else
            Application.EnableEvents = False
            cell.Offset(0, 1) = ""
        End If
    Next cell
    
    Application.EnableEvents = True 'reenable events

End Sub

 

[Schturman]

OK, I went back and re-read everything carefully, and I think I see what you are after.
I think the following code should do what you want, even dragging down multiple cells at once:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range

'   See if any cells updated in column B
    Set rng = Intersect(Target, Range("B:B"))
    If rng Is Nothing Then Exit Sub
   
'   Loop though all updated rows in column B
    For Each cell In rng
        If IsNumeric(cell.Value) Then
            Application.EnableEvents = False
            cell.Offset(0, 1) = Range("A2") * cell
        Else
            Application.EnableEvents = False
            cell.Offset(0, 1) = ""
        End If
    Next cell
   
    Application.EnableEvents = True 'reenable events

End Sub

WOW, it's so cool !
Yes, now it can drag and calculate and detect text. Thank you very much ! I again learned a lot

 

[Schturman]

Hmmm, one weird thing... When I delete a range of cells it write me zeroes in a column C (see pic) and I need to delete them again.
Can you fix it ?

 

[Joe4]

How exactly are you deleting the cells?
Are you just clearing the contents of a specific range?
Or are you deleting a range of rows?

 

[Micron]

Maybe the zeros are a result of a formula in C? Deleting the zeros deletes the formula so that wouldn't be good.

 

[Schturman]

How exactly are you deleting the cells?
Are you just clearing the contents of a specific range?
Or are you deleting a range of rows?

By selecting range and pressing Del button and zeroes appearing

 

[Schturman]

Maybe the zeros are a result of a formula in C? Deleting the zeros deletes the formula so that wouldn't be good.

Column C not have formulas, only VBA copy content of B.

 

[Schturman]

By selecting range and pressing Del button and zeroes appearing

I mean yes, just clearing the contents of a specific range