Sales commission program using Visual Basic 6

So, we found an old sales commission program that we developed in college, in Visual Basic 6. It still works good, and we were able to make it an executable. Good stuff! It still goes into our vintage collection though.

The sales commission program

In college, we called this program Open Door sales commission. Moreover, Open Door is a great name for a company. Most likely, that name is taken. Anyhow, it looks like a very professional program. So, even in college, you should produce good stuff.

Overall, this program was developed on a Windows PC. Therefore, it may not work on every computer. In addition, we will not go through the details of this program. It is vintage. So, just download it, play with it, and explore.

How it looks in run mode

Below is how the sales commission looks in run mode, and as an executable.

Download

Feel free to download this program. It is all open source. Click on the button below to download.

Download Size: 13 kB

Code listing

Here is the code for the Open Door program.

'OpenDoor
'Open Door--Sales Commission
'Professor Maiorisi--CIS 166
'Designed and programmed by: Alex Shaw III
'Date created: November 15, 2003
'Last modified: November 17, 2003
'
'Note: Printout in landscape mode
'
'This program calculates the total commission for a specific salesperson.
'
'Brief Commission and Bonus Breakdown:
'A sales commission is based on sales between $150,000 and $499,999.
'A volume commission is based on sales greater than $499,999.
'A $500 monthly quota bonus is granted for sales of $350,000+.
'A $100 monthly quota bonus is granted for sales below $350,000.
'A customer status bonus is granted based on the customer status.
Option Explicit                                                'require declaration of variables
'Assign constants
Const SalesLim = 150000                                        'sales bonus limit
Const VolLim = 499999                                          'volume bonus limit
Const QuotaLim = 350000                                        'quota bonus limit
Const StatBon1 = 1000                                          'new customer
Const StatBon2 = 750                                           'reinstating old customer
Const StatBon3 = 500                                           'reactivating inactive customer
Const StatBon4 = 250                                           'additional sale to customer
Const StatBon5 = 1000                                          'millionth dollar sale
Const ServRate1 = 0.05                                         'Project Management rate
Const ServRate2 = 0.04                                         'Requirements Definition rate
Const ServRate3 = 0.03                                         'System Design rate
Const ServRate4 = 0.06                                         'Programming rate
Const VolRate1 = 0.01                                          'Project Management volume rate
Const VolRate4 = 0.01                                          'Programming volume rate
'Status Messages
Const StatMes1 = "Congratulations on making a new customer!"
Const StatMes2 = "Congratulations on reinstating an old customer!"
Const StatMes3 = "Congratulations on activating an inactive customer!"
Const StatMes4 = "Congratulations on additional sale to current customer!"
Const StatMes5 = "Congratulations on millionth dollar sale!"
'Allocate variable space
Dim intStatusBonus As Integer
Dim intQuotaBonus As Single
Dim sngVolumeBonus As Single
Dim sngServiceBonus As Single
Dim sngTotalCommission As Single
Private Sub CalcCommission()                                   'Calculate commission
    'Allocate storage space
    Dim SType1, SType2, SType3, SType4 As Boolean              'service types 1, 2, 3, and 4
    Dim SalesAmt As Single                                     'sales amount
    
    'Assign values
    SType1 = optServiceType1.Value                             'project management
    SType2 = optServiceType2.Value                             'requirements definition
    SType3 = optServiceType3.Value                             'system design
    SType4 = optServiceType4.Value                             'programming service
    
    SalesAmt = Val(txtSalesAmount.Text)                        'sales amount
    'Initialize bonus values
    'User may not clear screen before entering next customer
    intQuotaBonus = 0
    sngVolumeBonus = 0
    sngServiceBonus = 0
    'Perform comparisons
    If ((SType1 = False) And (SType2 = False) And (SType3 = False) And (SType4 = False)) Then
        MsgBox ("Please Select a Service Type")
        optServiceType1.SetFocus                               'set focus to option list
        optServiceType1.Value = False                          'clear first option value
    Else
        If (SalesAmt >= 350000) Then intQuotaBonus = 500 Else intQuotaBonus = 100
        
        If ((SalesAmt > 499999) And ((SType1 = True) Or (SType4 = True))) Then
            If (SType1 = True) Then
                sngServiceBonus = SalesAmt * ServRate1
                sngVolumeBonus = SalesAmt * VolRate1
            Else
                sngServiceBonus = SalesAmt * ServRate4
                sngVolumeBonus = SalesAmt * VolRate4
            End If
            
            lblSalesStatus.Caption = "S, V"                    'service and volume bonus
        Else
            If (SalesAmt >= 150000) Then
                If (SType1 = True) Then sngServiceBonus = SalesAmt * ServRate1
                If (SType2 = True) Then sngServiceBonus = SalesAmt * ServRate2
                If (SType3 = True) Then sngServiceBonus = SalesAmt * ServRate3
                If (SType4 = True) Then sngServiceBonus = SalesAmt * ServRate4
            
                lblSalesStatus.Caption = "S"                   'service bonus only
            Else
                lblSalesStatus.Caption = "N"                   'no service bonus granted
            End If
        End If
    
        sngTotalCommission = intQuotaBonus + sngServiceBonus + sngVolumeBonus + intStatusBonus
            
        Call DisplayResults
    End If
End Sub
Private Sub Calculations()                                     'Perform calculations
    Call StatusMessage                                         'display status message
End Sub
Private Sub CenterForm()                                       'Centers a form on the screen
    frmOpenDoor.Top = (Screen.Height - frmOpenDoor.Height) / 2 'top position
    frmOpenDoor.Left = (Screen.Width - frmOpenDoor.Width) / 2  'left position
End Sub
Private Sub ClearValues()
'Clear and restore controls related to user control
    'Clear text boxes
    txtLastName.Text = ""                                      'last name
    txtFirstName.Text = ""                                     'first name
    txtMidInit.Text = ""                                       'middle initial
    txtSuffix.Text = ""                                        'suffix
    txtSalesAmount.Text = ""                                   'sales amount
    txtCustomerStatus.Text = ""                                'customer status
    
    'Clear option values
    optServiceType1.Value = False                              'Project Management
    optServiceType2.Value = False                              'Requirements Definition
    optServiceType3.Value = False                              'System Design
    optServiceType4.Value = False                              'Programming
    
    'Clear commission and bonus labels
    lblSalesCommission.Caption = ""                            'sales commission
    lblVolumeCommission.Caption = ""                           'volume commission
    lblStatusBonus.Caption = ""                                'customer status bonus
    lblQuotaBonus.Caption = ""                                 'monthly quota bonus
    lblTotalCommission.Caption = ""                            'total commission
    'Restore values
    lblStatusMessage.Caption = "Status Message"                'restore status message
    lblSalesStatus.Caption = ""                                'restore sales status
End Sub
Private Sub DisplayResults()                                   'Display results
    lblSalesCommission.Caption = Format(sngServiceBonus, "Currency")
    lblVolumeCommission.Caption = Format(sngVolumeBonus, "Currency")
    lblStatusBonus.Caption = Format(intStatusBonus, "Currency")
    lblQuotaBonus.Caption = Format(intQuotaBonus, "Currency")
    lblTotalCommission.Caption = Format(sngTotalCommission, "Currency")
End Sub
Private Sub Initialize()
    'Remove borders around labels
    lblSalesStatus.BorderStyle = 0                             'sales status
    lblSalesCommission.BorderStyle = 0                         'sales commission
    lblVolumeCommission.BorderStyle = 0                        'volume commission
    lblStatusBonus.BorderStyle = 0                             'customer status bonus
    lblQuotaBonus.BorderStyle = 0                              'monthly quota bonus
    lblTotalCommission.BorderStyle = 0                         'total commission
End Sub
Private Sub StatusMessage()                                    'Display status message
    'Initialize bonus value
    'User may not clear screen before entering next customer
    intStatusBonus = 0
    
    txtCustomerStatus.Text = UCase(txtCustomerStatus.Text)     'uppercase status character
    
    Select Case txtCustomerStatus.Text                         'check customer status
        Case "N"                                               'new customer
            intStatusBonus = StatBon1
            lblStatusMessage.Caption = StatMes1
            Call CalcCommission
        Case "R"                                               'old customer
            intStatusBonus = StatBon2
            lblStatusMessage.Caption = StatMes2
            Call CalcCommission
        Case "I"                                               'inactive customer
            intStatusBonus = StatBon3
            lblStatusMessage.Caption = StatMes3
            Call CalcCommission
        Case "C"                                               'current customer
            intStatusBonus = StatBon4
            lblStatusMessage.Caption = StatMes4
            Call CalcCommission
        Case "X"                                               'millionth dollar sale
            intStatusBonus = StatBon5
            lblStatusMessage.Caption = StatMes5
            Call CalcCommission
        Case Else
            MsgBox ("Please Enter a Valid Customer Status")
            txtCustomerStatus.SetFocus
    End Select
End Sub
Private Sub cmdCalc_Click()
    Call Calculations                                          'clear values
End Sub
Private Sub cmdClear_Click()
    Call ClearValues                                           'clear values
End Sub
Private Sub cmdExit_Click()
    End                                                        'end program
End Sub
Private Sub cmdPrint_Click()
    PrintForm                                                  'print form
End Sub
Private Sub Form_Load()
    Initialize                                                 'initialize program elements
    CenterForm                                                 'center form
End Sub

The video

Here is a very short video of how to use the Open Door program. Make sure you subscribe to Techronology on YouTube, as we plan to do some stuff.

What is next?

Guess what? Now that we know VB6 still works on our system, we may start using it again. Even pinned it to our taskbar. Once we saw that we were able to create an executable, that was it. So, look out!

Techronology home Software home