Excel VBA

Build A Formula

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

=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))