VBA Worksheet_change help

Phantom645

New member
Joined
Nov 14, 2011
Messages
3
Reaction score
0
Points
0
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
 
For example:
Code:
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
 
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!
 
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...

Code:
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. :)
 
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
 
In other words, something like this:
Code:
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
 
Thanks Joe and Ken. Your suggestions worked a treat!

Really appreciated!

Regards,

Paul
 
Back
Top