Results 1 to 7 of 7

Thread: VBA Worksheet_change help

  1. #1

    VBA Worksheet_change help



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    170
    Articles
    0
    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

  3. #3
    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!

  4. #4
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,021
    Articles
    79
    Blog Entries
    14
    Quote Originally Posted by Phantom645 View Post
    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.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  5. #5
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    170
    Articles
    0
    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
    Circumference of a circle = 2πr˛



    ˛the circle's radius

  6. #6
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    170
    Articles
    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
    Circumference of a circle = 2πr˛



    ˛the circle's radius

  7. #7
    Thanks Joe and Ken. Your suggestions worked a treat!

    Really appreciated!

    Regards,

    Paul

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •