VBA Worksheet_change help

[Phantom645]

Hello everyone,

I'm a newbie so please be gentle!

I want Excel to automatically apply a formula to the cell that the user has just entered data into.

I am trying to learn VBA over the internet with limited success.

Code I have been playing with that has been working fine so far is:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("L7:L10")) Is Nothing Then
Application.EnableEvents = False
Target = Target * 2
Application.EnableEvents = True
End If
End Sub

I have been using the above to get me to a point where I can automatically manipulate the user entry data. But I need the formula of “Target * 2” above to actually be “SUM(Round(“Target”/$E$7,0)*$E$7)”

In other words, divide the Target by Cell "E7", Round the result to zero decimal places, and then multiply the new result by Cell "E7".

My problem is I do not know the code. Can anyone help me please?

Thanks a million team.

Regards,

Paul

[JoePublic]

For example:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rCell             As Excel.Range
   
   If Not Intersect(Target, Range("L7:L10")) Is Nothing Then
      On Error GoTo oops
      Application.EnableEvents = False
      
      For Each rCell In Intersect(Target, Range("L7:L10")).Cells
         If Len(rCell.Value2) > 0 Then
            rCell.Value2 = Application.WorksheetFunction.Round(rCell.Value2 / Range("E7").Value2, 0) * Range("E7").Value2
         End If
      Next rCell
   
   End If

leave:
   Application.EnableEvents = True
   Exit Sub
oops:
   MsgBox Err.Description
   Resume leave
End Sub

[Phantom645]

Joe,

This worked a treat! Thanks a lot.

If I wanted to replicate the command for other parts of the same worksheet. What changes would I need to make?

For example, say I wanted to apply the same formula to the following references:

For Range ("L7:AO7") use Range ("E7") as the reference
For Range ("L12:AO12") use Range ("E12") as the reference
For Range ("L17:AO17") use Range ("E17") as the reference
For Range ("L22:AO22") use Range ("E22") as the reference
For Range ("L27:AO27") use Range ("E27") as the reference ...etc

Thanks again!

[Ken Puls]

I'm a newbie so please be gentle! {snip} I am trying to learn VBA over the internet with limited success.

Great, and welcome! Ask away, and we'll see if we can't help you learn this stuff.

I've added one more condition to this. Depending on how many you have, we may want to look for a different way though... Be careful that you don't have any ranges that overlap with one you've already provided, or you may find something getting overwritten...

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rCell             As Excel.Range
   
   If Not Intersect(Target, Range("L7:L10")) Is Nothing Then
      On Error GoTo oops
      Application.EnableEvents = False
      
      For Each rCell In Intersect(Target, Range("L7:L10")).Cells
         If Len(rCell.Value2) > 0 Then
            rCell.Value2 = Application.WorksheetFunction.Round(rCell.Value2 / Range("E7").Value2, 0) * Range("E7").Value2
         End If
      Next rCell
   End If
   If Not Intersect(Target, Range("L12:AO12")) Is Nothing Then
      On Error GoTo oops
      Application.EnableEvents = False
      
      For Each rCell In Intersect(Target, Range("L12:AO12")).Cells
         If Len(rCell.Value2) > 0 Then
            rCell.Value2 = Application.WorksheetFunction.Round(rCell.Value2 / Range("E12").Value2, 0) * Range("E12").Value2
         End If
      Next rCell
   End If
   
   'Add more here...
   
leave:
   Application.EnableEvents = True
   Exit Sub
oops:
   MsgBox Err.Description
   Resume leave
End Sub

Let us know if you need any more help with this.

[JoePublic]

If the ranges are always regular like that, you can simplify by testing for intersection with range L:AO and also if (Row - 7) Mod 5 = 0

[JoePublic]

In other words, something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rCell             As Excel.Range
   
   If Not Intersect(Target, Range("L:AO")) Is Nothing Then
      On Error GoTo oops
      Application.EnableEvents = False
      
      For Each rCell In Intersect(Target, Range("L:AO")).Cells
         If Len(rCell.Value2) > 0 And (rCell.Row - 7) Mod 5 = 0 Then
            rCell.Value2 = Application.WorksheetFunction.Round(rCell.Value2 / Cells(rCell.Row, "E").Value2, 0) * Cells(rCell.Row, "E").Value2
         End If
      Next rCell
   
   End If

leave:
   Application.EnableEvents = True
   Exit Sub
oops:
   MsgBox Err.Description
   Resume leave
End Sub

[Phantom645]

Thanks Joe and Ken. Your suggestions worked a treat!

Really appreciated!

Regards,

Paul