Excel VBA

Build A Formula

Sometimes it seems that no matter how hard you try, somebody wants more. In this case, we needed a formula to be placed in a cell when the spreadsheet was created so that if sales figures were tweaked, the commission would change.

Most of the salesmen’s names were in the system like AB, RD, TS, etc. Occasionally 2 salesmen would split a commission and I had to work out a scheme that my program could always recognize.

The syntax is 2 initials, the first commission percentage, 2 more initials and the second percentage; i.e. ABØ25JBØ75.

Not shown is the part where I compute 2 character initials. Also, this had to ignore initials of other people who are not subject to commission.


 Case 10    
     'JR###DS###
                FirstCommPers = Left(Cells(Missio, 14), 2)	 'Initials of 1st
                SecCommPers = Mid(Cells(Missio, 14), 6, 2)	 'Initials of 2nd
                FirstCommAmt = Mid(Cells(Missio, 14), 3, 3)	 '% of 1st
                SecCommAmt = Right(Cells(Missio, 14), 3)	 '% of 2nd
          Select Case FirstCommPers
                    Case "JR", "DL"
'=IF(LEN(N84)=10,IF(LEFT(N84,2)="JR",(J84-G84)*0.2*ABS(MID(N84,3,3))/100))
'04/14/2004
                          FirstJTD = "=IF(len(" & Cells(Missio, 14).Address & ")=10,if(left(" & _
                   Cells(Missio, 14).Address & ",2)=" & Chr(34) & FirstCommPers & Chr(34) _
                  & ",(" & Cells(Missio, 10).Address & "-" & Cells(Missio, 7).Address & ")*0.2*" _
                  & "abs(mid(" & Cells(Missio, 14).Address & ",3,3))/100))"
 '  Get the formula for the 1st half of Commission for 20% people
                        FirstMTD = ((Cells(Missio, 15) -  Cells(Missio, 16)) * (FirstCommAmt / 100))
                    Case "BS", "SD"
                        FirstJTD = "=IF(len(" & Cells(Missio, 14).Address & ")=10,if(left(" & _
                          Cells(Missio, 14).Address & ",2)=" & Chr(34) & FirstCommPers & Chr(34) _
                          & ",(" & Cells(Missio, 10).Address & "-" & Cells(Missio, 7).Address & ")*0.05*" _
                          & "abs(mid(" & Cells(Missio, 14).Address & ",3,3))/100))"
 '  Get the formula for the 1st half of Commission for 5% people
'Don't forget the word Address or you get absolutes
                        FirstMTD = ((Cells(Missio, 15) - Cells(Missio, 16)) * (FirstCommAmt / 100))
                    Case Else
                        FirstJTD = 0
                        FirstMTD = 0
                End Select
                Select Case SecCommPers	 '2nd Commission
                    Case "JR", "DL"
                        SecJTD = "IF(len(" & Cells(Missio, 14).Address & ")=10,if(mid(" & _
                            Cells(Missio, 14).Address & ",6,2)=" & Chr(34) & SecCommPers & Chr(34) _
                            & ",(" & Cells(Missio, 10).Address & "-" & Cells(Missio, 7).Address & ")*0.2*" _
                           & "abs(mid(" & Cells(Missio, 14).Address & ",8,3))/100))"
 '  Get the formula for the 2nd half of Commission for 20% people
                        SecMTD = ((Cells(Missio, 15) - _
                            Cells(Missio, 16)) * (FirstCommAmt / 100))
                    Case "BS", "SD"
                        SecJTD = "IF(len(" & Cells(Missio, 14).Address & ")=10,if(mid(" & _
                           Cells(Missio, 14).Address & ",6,2)=" & Chr(34) & SecCommPers & Chr(34) _
                           & ",(" & Cells(Missio, 10).Address & "-" & Cells(Missio, 7).Address & ")*0.05*" _
                           & "abs(mid(" & Cells(Missio, 14).Address & ",8,3))/100))"
                        SecMTD = ((Cells(Missio, 15) - Cells(Missio, 16)) * (FirstCommAmt / 100))
                    Case Else
                        SecJTD = 0
                        SecMTD = 0
                End Select
'Finally put the 2 halves together. Only JR, DL, BS, & SD get commission
                If FirstJTD = 0 Then
                    JTDComm = "=" & SecJTD
                Else
                    JTDComm = FirstJTD & "+" & SecJTD
                End If
                MTDcomm = FirstMTD + SecMTD
                range("O" & Missio).formula = JTDComm	 'Col O gets formula
                range("Q" & Missio).formula = "=IF(iserror(" & Cells(Missio, 15).Address & "-" & _
                    Cells(Missio, 16).Address & "),0," & Cells(Missio, 15).Address & " - " & _
                    Cells(Missio, 16).Address & ")"	 'Col Q formula

The resulting formula looks like this in the spreadsheet:

=IF(LEN($N$80)=10,IF(LEFT($N$80,2)="BS",($J$80-$G$80)*0.05*ABS(MID($N$80,3,3))/100))+IF(LEN($N$80)=10,IF(MID($N$80,6,2)="DL",($J$80-$G$80)*0.2*ABS(MID($N$80,8,3))/100))

Glad I only had to type it once to figure out how to generate it in code.

Updated:	06/21/2024 07:42
This page added:	26 April 2004