Which Worksheet Event is best for calculations?

[oldman]

I am currently using "Worksheet_SelectionChange" to calculate commissions and it's a bit slow. Should I be using something else?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set ws = Worksheets("Sheet2")
Application.ScreenUpdating = False
ws.Unprotect
 
      
    With ws
    
    Range("k4").Value = 0 'Gross profit %
    Range("j5") = WorksheetFunction.Sum(Range("j8", Range("j8").End(xlDown))) 'Total sale
    Range("j3") = WorksheetFunction.Sum(Range("H8", Range("H8").End(xlDown))) 'Total cost
    Range("j4") = Range("j5") - Range("j3") 'Gross profit $
    If Range("j4") > 0 Then Range("k4") = Range("j4") / Range("j5") 'Gross profit %
    If Range("j4") > 0 Then Range("g3") = Range("h3") / Range("j4")
    If Range("j4") = 0 Then Range("g3") = 0
        'Gross margin tier paid on gross margin
    If Range("k$4") >= -0.99 <= 0.3574 Then Range("h3") = Range("j4") * 0.02
    If Range("k$4") >= 0.3575 <= 0.3824 Then Range("h3") = Range("j4") * 0.045
    If Range("k$4") >= 0.3825 <= 0.4074 Then Range("h3") = Range("j4") * 0.07
    If Range("k$4") >= 0.4075 <= 0.4324 Then Range("h3") = Range("j4") * 0.09
    If Range("k$4") >= 0.4325 <= 0.4574 Then Range("h3") = Range("j4") * 0.1075
    If Range("k$4") >= 0.4575 <= 0.4822 Then Range("h3") = Range("j4") * 0.1175
    If Range("k$4") >= 0.4825 <= 0.5024 Then Range("h3") = Range("j4") * 0.125
    If Range("k$4") >= 0.5025 <= 0.5299 Then Range("h3") = Range("j4") * 0.1325
    If Range("k$4") >= 0.53 <= 0.5574 Then Range("h3") = Range("j4") * 0.14
    If Range("k$4") >= 0.5575 <= 0.5824 Then Range("h3") = Range("j4") * 0.145
    If Range("k$4") >= 0.5825 <= 0.6074 Then Range("h3") = Range("j4") * 0.15
    If Range("k$4") >= 0.6075 <= 0.6299 Then Range("h3") = Range("j4") * 0.1525
    If Range("k$4") >= 0.63 Then Range("h3") = Range("j4") * 0.15
    
   
End With
'ws.Protect
End Sub

[SamT]

You do realize that your sub is running every time a cell is selected by mouse, tab, or enter?

I am really bushed, so this probably has errors

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim GrossProfitPercent As Double 'You do a lot with k4
  Dim h3 As Range 'See above, but rename this to indicate the data name
  Dim J4 As Double 'See above
    
  'Do not run sub if:
  'too many Cells selected
  If Target.Count > 1 Then Exit Sub
  
  '"A1" was not selected
  'If Not Target Is Range("A1") Then Exit Sub.
  
  'The selection was in a certain range
  If Not Intersect(Target, Range(Range("H8"), Cells(Rows.Count, "J"))) Is Nothing Then Exit Sub
  
    Set ws = Worksheets("Sheet2") 'Is this code in sheet2's code page?
    'All code in a sheet's code page alway applies to that sheet unlesss other wise coded.
    Application.ScreenUpdating = False
    ws.Unprotect
    ' "Me.Unptotect" will apply to the code pages Parent sheet.
     
    With ws
      Set h3 = .Range("h3")
      
      
        .Range("k4").Value = 0 'Gross profit %
        .Range("j5") = WorksheetFunction.Sum(.Range("j8", .Range("j8").End(xlDown))) 'Total sale
        .Range("j3") = WorksheetFunction.Sum(.Range("H8", .Range("H8").End(xlDown))) 'Total cost
        .Range("j4") = .Range("j5") - .Range("j3") 'Gross profit $
        
        J4 = .Range("j4").Value
        .Range("g3") = 0
        If J4 > 0 Then
            .Range("k4") = J4 / .Range("j5") 'Gross profit %
            .Range("g3") = .Range("h3") / J4
        End If
        GrossProfitPercent = .Range("k4")
        Select Case GrossProfitPercent
         'Gross margin tier paid on gross margin
          Case Is >= 0.63:  h3 = J4 * 0.15
          Case Is > 0.6075: h3 = J4 * 0.1525
          Case Is > 0.5825: h3 = J4 * 0.15
          Case Is > 0.5575: h3 = J4 * 0.145
          Case Is > 0.53:   h3 = J4 * 0.14
          Case Is > 0.5025: h3 = J4 * 0.1325
          Case Is > 0.5025: h3 = J4 * 0.1325
          Case Is > 0.4575: h3 = J4 * 0.1175
          Case Is > 0.4325: h3 = J4 * 0.1075
          Case Is > 0.4075: h3 = J4 * 0.09
          Case Is > 0.3825: h3 = J4 * 0.07
          Case Is > 0.3575: h3 = J4 * 0.045
          Case Is > -0.99:  h3 = J4 * 0.02
          'Case Else: h3 = 0
        End Select
         
    End With
     'ws.Protect
End Sub

[snb]

in H3:

= J4*CHOOSE(INTK4-.3325)\.025,.02,.045,.07,.09,.1075,.1175, .... ,.15)

[Paul_Hossler]

Not tested, but some ideas:

Biggest ones are to turn off events in the handle to avoid re-triggering it, and to test what cell(s) were changed to see if you even need to run it

The other changes probably won't have as much impact

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    
    '--------------------- Dim to avoid having to reference the WS and Range objects
    Dim dTotalSale As Double, dTotalCost As Double, dGrossProfit  As Double, dGrossProfitPercent As Double
    
    '--------------------- no need to hard code ws name
    Set ws = Target.Parent
    
    
    '---------------- not sure which cells have changes that  affect the calculations
    '-----------------but if a cell changes (e.g. A1) that does not affect the calc, faster to just get out
    '----------------- so the the Target cell(s) is NOT col col 8 and not in col 10, there's no need to go through the rest
    If (Intersect(Target, ws.Columns(8)) Is Nothing And Intersect(Target, ws.Columns(10)) Is Nothing) Then Exit Sub
    
    
    
    
    '------------------  you really need this to avoid re-triggering by the event
    '------------------- by the changes you make in the sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ws.Unprotect
     
     
    With ws
         
        '----------------k$4 ????????????????
        Range("k4").Value = 0 'Gross profit %
        
        Range("j5") = WorksheetFunction.Sum(Range("j8", Range("j8").End(xlDown))) 'Total sale
        Range("j3") = WorksheetFunction.Sum(Range("H8", Range("H8").End(xlDown))) 'Total cost
        Range("j4") = Range("j5") - Range("j3") 'Gross profit $
        
        dTotalSale = Range("j5").Value
        dTotalCost = Range("j3").Value
        dGrossProfit = Range("j4").Value
        
        
        
        
        '------------------ possible to be negative???????????
        If Range("j4") <> 0 Then
            Range("k4") = Range("j4") / Range("j5") 'Gross profit %
            Range("g3") = Range("h3") / Range("j4")
        Else
            Range("g3") = 0
        End If
         
         dGrossProfitPercent = Range("k4").Value
         
         'Gross margin tier paid on gross margin
        '------------------------ Select Case is faster than the IF/Thens you had
        '------------------------- BTW, you should have used If/Then/ElseIf's since
        '------------------------- since when you found a match, you still tested the other IF's unnecessarily
        Select Case dGrossProfitPercent
            Case Is >= -0.99 <= 0.3574
                Range("h3") = dGrossProfit * 0.02
            Case Is <= 0.3824
                Range("h3") = dGrossProfit * 0.045
            Case Is <= 0.4074
                Range("h3") = dGrossProfit * 0.07
            Case Is <= 0.4324
                Range("h3") = dGrossProfit * 0.09
            Case Is <= 0.4574
                Range("h3") = dGrossProfit * 0.1075
            Case Is <= 0.4822
                Range("h3") = dGrossProfit * 0.1175
            Case Is <= 0.5024
                Range("h3") = dGrossProfit * 0.125
            Case Is <= 0.5299
                Range("h3") = dGrossProfit * 0.1325
            Case Is <= 0.5574
                Range("h3") = dGrossProfit * 0.14
            Case Is <= 0.5824
                Range("h3") = dGrossProfit * 0.145
            Case Is <= 0.6074
                Range("h3") = dGrossProfit * 0.15
            Case Is <= 0.6299
                Range("h3") = dGrossProfit * 0.1525
            Case Else
                Range("h3") = dGrossProfit * 0.15
        End Select
         
         
    End With
    
    '------------------------ and this
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    
    ws.Protect
End Sub

Paul

[oldman]

You do realize that your sub is running every time a cell is selected by mouse, tab, or enter?

I am really bushed, so this probably has errors

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim GrossProfitPercent As Double 'You do a lot with k4
  Dim h3 As Range 'See above, but rename this to indicate the data name
  Dim J4 As Double 'See above
    
  'Do not run sub if:
  'too many Cells selected
  If Target.Count > 1 Then Exit Sub
  
  '"A1" was not selected
  'If Not Target Is Range("A1") Then Exit Sub.
  
  'The selection was in a certain range
  If Not Intersect(Target, Range(Range("H8"), Cells(Rows.Count, "J"))) Is Nothing Then Exit Sub
  
    Set ws = Worksheets("Sheet2") 'Is this code in sheet2's code page?
    'All code in a sheet's code page alway applies to that sheet unlesss other wise coded.
    Application.ScreenUpdating = False
    ws.Unprotect
    ' "Me.Unptotect" will apply to the code pages Parent sheet.
     
    With ws
      Set h3 = .Range("h3")
      
      
        .Range("k4").Value = 0 'Gross profit %
        .Range("j5") = WorksheetFunction.Sum(.Range("j8", .Range("j8").End(xlDown))) 'Total sale
        .Range("j3") = WorksheetFunction.Sum(.Range("H8", .Range("H8").End(xlDown))) 'Total cost
        .Range("j4") = .Range("j5") - .Range("j3") 'Gross profit $
        
        J4 = .Range("j4").Value
        .Range("g3") = 0
        If J4 > 0 Then
            .Range("k4") = J4 / .Range("j5") 'Gross profit %
            .Range("g3") = .Range("h3") / J4
        End If
        GrossProfitPercent = .Range("k4")
        Select Case GrossProfitPercent
         'Gross margin tier paid on gross margin
          Case Is >= 0.63:  h3 = J4 * 0.15
          Case Is > 0.6075: h3 = J4 * 0.1525
          Case Is > 0.5825: h3 = J4 * 0.15
          Case Is > 0.5575: h3 = J4 * 0.145
          Case Is > 0.53:   h3 = J4 * 0.14
          Case Is > 0.5025: h3 = J4 * 0.1325
          Case Is > 0.5025: h3 = J4 * 0.1325
          Case Is > 0.4575: h3 = J4 * 0.1175
          Case Is > 0.4325: h3 = J4 * 0.1075
          Case Is > 0.4075: h3 = J4 * 0.09
          Case Is > 0.3825: h3 = J4 * 0.07
          Case Is > 0.3575: h3 = J4 * 0.045
          Case Is > -0.99:  h3 = J4 * 0.02
          'Case Else: h3 = 0
        End Select
         
    End With
     'ws.Protect
End Sub

Yes, I do realize sub runs everytime the wind blows hence the reason for asking. I will try your solution and let you know.

[oldman]

So many choices . . .I soooo confused! Not really.

All of you have provided great alternatives to what I am currently using. Thank you!

[oldman]

I understand most of the script but unsure as to what you are stating in your opening statement.

Not tested, but some ideas:

Biggest ones are to turn off events in the handle to avoid re-triggering it, and to test what cell(s) were changed to see if you even need to run it

The other changes probably won't have as much impact

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    
    '--------------------- Dim to avoid having to reference the WS and Range objects
    Dim dTotalSale As Double, dTotalCost As Double, dGrossProfit  As Double, dGrossProfitPercent As Double
    
    '--------------------- no need to hard code ws name
    Set ws = Target.Parent
    
    
    '---------------- not sure which cells have changes that  affect the calculations
    '-----------------but if a cell changes (e.g. A1) that does not affect the calc, faster to just get out
    '----------------- so the the Target cell(s) is NOT col col 8 and not in col 10, there's no need to go through the rest
    If (Intersect(Target, ws.Columns(8)) Is Nothing And Intersect(Target, ws.Columns(10)) Is Nothing) Then Exit Sub
    
    
    
    
    '------------------  you really need this to avoid re-triggering by the event
    '------------------- by the changes you make in the sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ws.Unprotect
     
     
    With ws
         
        '----------------k$4 ????????????????
        Range("k4").Value = 0 'Gross profit %
        
        Range("j5") = WorksheetFunction.Sum(Range("j8", Range("j8").End(xlDown))) 'Total sale
        Range("j3") = WorksheetFunction.Sum(Range("H8", Range("H8").End(xlDown))) 'Total cost
        Range("j4") = Range("j5") - Range("j3") 'Gross profit $
        
        dTotalSale = Range("j5").Value
        dTotalCost = Range("j3").Value
        dGrossProfit = Range("j4").Value
        
        
        
        
        '------------------ possible to be negative???????????
        If Range("j4") <> 0 Then
            Range("k4") = Range("j4") / Range("j5") 'Gross profit %
            Range("g3") = Range("h3") / Range("j4")
        Else
            Range("g3") = 0
        End If
         
         dGrossProfitPercent = Range("k4").Value
         
         'Gross margin tier paid on gross margin
        '------------------------ Select Case is faster than the IF/Thens you had
        '------------------------- BTW, you should have used If/Then/ElseIf's since
        '------------------------- since when you found a match, you still tested the other IF's unnecessarily
        Select Case dGrossProfitPercent
            Case Is >= -0.99 <= 0.3574
                Range("h3") = dGrossProfit * 0.02
            Case Is <= 0.3824
                Range("h3") = dGrossProfit * 0.045
            Case Is <= 0.4074
                Range("h3") = dGrossProfit * 0.07
            Case Is <= 0.4324
                Range("h3") = dGrossProfit * 0.09
            Case Is <= 0.4574
                Range("h3") = dGrossProfit * 0.1075
            Case Is <= 0.4822
                Range("h3") = dGrossProfit * 0.1175
            Case Is <= 0.5024
                Range("h3") = dGrossProfit * 0.125
            Case Is <= 0.5299
                Range("h3") = dGrossProfit * 0.1325
            Case Is <= 0.5574
                Range("h3") = dGrossProfit * 0.14
            Case Is <= 0.5824
                Range("h3") = dGrossProfit * 0.145
            Case Is <= 0.6074
                Range("h3") = dGrossProfit * 0.15
            Case Is <= 0.6299
                Range("h3") = dGrossProfit * 0.1525
            Case Else
                Range("h3") = dGrossProfit * 0.15
        End Select
         
         
    End With
    
    '------------------------ and this
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    
    ws.Protect
End Sub

Paul

[oldman]

I used all the recommendation and all execute perfectly. Thank you.

[SamT]

It might be easiest to choose one cell to select that will trigger the macro.

IF Not Target Is Range("A1") then Exit Sub

Sometimes you want to tell others how to do it. With Range("A1:C1"). Inclusively border and color them. In A1 enter "Click to Run Macro." Horizontal Align them "Center Across Selection."

If Not Intersect(Target, Range("A1:C1")) Then Exit Sub

If you want to run the macro on one row of a column of trigger cells:

If Not Intersect(Target, Range("A3:A10)) Then Exit Sub
With Rows(Target.Row)
'Do stuff
End With

IF you want to allow a Range to be selectable, (for Copy, Paste, etc,) and to be a trigger Range, use the BeforeDoubleClick Event

Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A10)) Then Exit Sub
'Do Stuff
End Sub

[Paul_Hossler]

Since you were concerned about performance I suggested some things that typically help. The first two suggestions usually provide the most return, unless there's a lot of data

I understand most of the script but unsure as to what you are stating in your opening statement.

1. When .EnableEvents = True, your event handler will trigger itself a second time, and if that call updates a worksheet cell, then that will call the event handler a third time, etc.
By disabling events within an event handler you can avoid that, and then re-enable events after all cells that need to be updated are.

2. Worksheet_SelectionChange is triggered when ever ANY cell on that worksheet is changed. If you change a cell that you do not need to handle, it's quicker to just exit without going through the logic that is not needed. Since it looked like only changes in col H and J to generate any sheet value updates


[CODE][
If (Intersect(Target, ws.Columns(8)) Is Nothing And Intersect(Target, ws.Columns(10)) Is Nothing) Then Exit Sub
/CODE]

just says that if the Target range (i.e. the group of cells that changes) does not overlap H or J, might as well exit since there's no point in executing the rest of the code since it will not affect the sheet.


Put a breakpoint on the first line in your event handler, and make a change, and then single step through to see what's happening (regardless of which or whose ideas you end up using)


Paul

[oldman]

Great recommendations from both of you. It will take time for me to digest. Thank you

[oldman]

If Not Intersect(Target, Range(Range("H8"), Cells(Rows.Count, "J"))) Is Nothing Then Exit Sub

Does the above code only affect row 8? I beleive the calculations need to be triggered when a quantity(column e) is entered or the unit retail (column I) is changed. Would the above code then be:

If Not Intersect(Target, Range(Range("E8"), Cells(Rows.Count, "I"))) Is Nothing Then Exit Sub

[Paul_Hossler]

Range(Range("H8"), Cells(Rows.Count, "J"))

That looks like the range H8:J1048576


[CODE][
If Not Intersect(Target, Range(Range("H8"), Cells(Rows.Count, "J"))) Is Nothing Then Exit Sub
/CODE]

Change I9

Intersect (I9, H8:J1048576) = I9 (the only cell that they have in common) <> Nothing

Intersect () = Nothing is FALSE

Not (FALSE) = TRUE so Exit Sub




This says that if the range of cells does not overlap col E or col J the sub exits

[
If (Intersect(Target, ws.Columns(5)) Is Nothing And Intersect(Target, ws.Columns(9)) Is Nothing) Then Exit Sub

Example:

Change A1 so Target = A1
Intersect (A1, E:E) = Nothing
Intersect (A1, J:J) = Nothing

TRUE and TRUE = TRUE so Exit Sub

Change E5 so Target = E5
Intersect (E5, E:E) = E5
Intersect (E5, J:J) = Nothing

FALSE and TRUE = FALSE so don't Exit Sub

Paul

[snb]

I used all the recommendation and all execute perfectly. Thank you.

Did you ?

http://www.vbaexpress.com/forum/show...l=1#post298370

[oldman]

If you are referring to testing all the recommeded solutions, yes I have. I want to avoid using worksheet fomulas, though more efficient, to prevent users from deleting those formulas. I could use a protected environment but that's not 100% safe in my opinion. Using VBA for my calculations, I believe, is safer.

There are a number of experts who believe worksheet formulas are the best. What is your opinion?

[snb]

Excel has been designed for calculations in cells in worksheets.
Why else would you use it ?

You can do all the calculations in a hidden worksheet and transfer all results to the worksheet that you design as user interface.

I wouldn't rebuild in VBA what is built-in in Excel's formulae.

[oldman]

Is that what you perform on your client applications? What method do most consultants provide?