User Form calculator (demonstration)


Calculator custom dialog box


xlf-calculator-user-form-demo
Fig 1: UserForm frmCalculate - showing Normal mode (left) and Output mode (right)

the VBA code


0. Module declaration and Initialize event



Code 0a: Sub UserForm module declarations and Initialize event
Option Explicit
' Module level declarations
Dim num1 As Double, num2 As Double
Dim outRange As Range

'' ============================
'' Module contents
'' Written by Ian O'Connor
'' excelatfinance.com
' =============================
' 0. Start UserForm controls and events
'   0.0 Initialize Event
'   0.1 Form controls
'       0.1.1 Output Click
'       0.1.2 Close Click
' 1. Start Operator frame controls
'   1.1 Multiply Click
' 2. Start Input frame controls
'   2.1 Number #1 Spin Change
'   2.2 Number #1 Text KeyPress
'   2.3 Number #1 Text Change
'   2.4 Number #2 Spin Change
'   2.5 Number #2 Text KeyPress
'   2.6 Number #2 Text Change
' 3. Start Result frame controls
'   3.1 Result Change
' 4. Start Output frame controls
'   4.1 Output DropButtonClick
'   4.2 Output Click
' 5. Start calculation engine
'   5.1 Multiply
'   5.2 Divide
' =============================


' =============================
' 0. Start UserForm controls and events
' =============================
' 0.1 Initialize Event
Private Sub UserForm_Initialize()

Dim BackColor As Long: BackColor = RGB(153, 255, 102)
Dim BackColor2 As Long: BackColor2 = RGB(0, 102, 0)
Dim ForColor As Long: ForColor = RGB(255, 255, 153)

    With Me
        .BackColor = BackColor
        .lblNumber1.BackColor = BackColor
        .lblNumber2.BackColor = BackColor
        .lblOutput.BackColor = BackColor
        .lblResult.BackColor = BackColor

        .fraInput.BackColor = BackColor
        .fraOutput.BackColor = BackColor
        .fraOperator.BackColor = BackColor
        .fraResult.BackColor = BackColor

        .chkOutput.BackColor = BackColor
        .optMultiply.BackColor = BackColor
        .optDivide.BackColor = BackColor

        .cmdClose.BackColor = BackColor2
        .cmdOutput.BackColor = BackColor2


        .cmdClose.ForeColor = ForColor
        .cmdOutput.ForeColor = ForColor

        .txtNumber1.Text = 1
        .txtNumber2.Text = 1
        .spnNumber1.Value = 1
        .spnNumber2.Value = 1
        .optMultiply.Value = True
         Call multiply1

        ' Attach a ReduceStyleDropButton to the TextBox
        .txtOutputRange.DropButtonStyle = fmDropButtonStyleReduce
        .txtOutputRange.ShowDropButtonWhen = fmShowDropButtonWhenAlways
    End With


End Sub
'

0.1 Output frame control events



Code 0b: procedures
' =============================
' 0.1 Form controls
' 0.1.1 Output Click
Private Sub cmdOutput_Click()
Dim Caption(0 To 4, 0 To 1) As String

Caption(0, 0) = "First number"
Caption(1, 0) = "Second number"
Caption(2, 0) = "Result"
Caption(3, 0) = "Operation"
Caption(4, 0) = "Multiplication"
Caption(4, 1) = "Division"

    On Error GoTo errorhandler
    outRange.Select
    Selection.Resize(1, 1).Select

    Application.ScreenUpdating = False
    With Selection
        .EntireColumn.ColumnWidth = 15
        .Offset(0, 1).EntireColumn.ColumnWidth = 15
        .Offset(0, 0).Value = Caption(0, 0)
        .Offset(0, 1).Value = Val(Me.txtNumber1)

        .Offset(1, 0).Value = Caption(1, 0)
        .Offset(1, 1).Value = Val(Me.txtNumber2)

        .Offset(2, 0).Value = Caption(2, 0)
        .Offset(2, 1).Value = Val(Me.txtResult)
        .Offset(2, 1).NumberFormat = "#,##0.000"

        .Offset(3, 0).Value = "Operation"
         If optMultiply.Value = True Then
             .Offset(3, 1).Value = Caption(4, 0)
         Else
            .Offset(3, 1).Value = Caption(4, 1)
         End If
            .Offset(3, 1).HorizontalAlignment = xlHAlignRight
    End With
    Application.ScreenUpdating = True

        lblOutput.Enabled = False
        chkOutput.Value = False
        cmdOutput.Enabled = False
        txtOutputRange.Text = ""
        txtOutputRange.Enabled = False
    Exit Sub
errorhandler:
    MsgBox "You have entered an invalid range", vbCritical, "xlf Warning"
    txtOutputRange.Text = ""
    Exit Sub

End Sub

' =============================
' 0.1.2 Close Click
Private Sub CmdClose_Click()

    FrmCalc.Hide

End Sub
' =============================
' ### End UserForm controls and events
' =============================
'

1. Operator frame control events



Code 1: procedures
' =============================
' 1. Start Operator frame controls
' =============================
' 1.1 Multiply Click
Private Sub OptMultiply_Click()

    If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then
        Call multiply1
    Else
        txtResult.Text = ""
    End If
    Call txtResult_Change
End Sub

' =============================
' 1.1 Divide Click
Private Sub OptDivide_Click()

    If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then
        Call divide1
    Else
        txtResult.Text = ""
    End If
    Call txtResult_Change
End Sub
' =============================
' ### End Operator frame controls
' =============================
'

2. Input frame control events



Code 2: procedures

' =============================
' 2. Start Input frame controls
' =============================
' 2.1 Number #1 Spin Change
Private Sub SpnNumber1_Change()

        If txtNumber1.Text = "" Then
                spnNumber1.Value = 1
                num1 = 1
        End If

        txtNumber1.Text = spnNumber1.Value
        num1 = spnNumber1.Value

End Sub

' =============================
' 2.2 Number #1 Text KeyPress
Private Sub txtNumber1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Select Case KeyAscii
        ' Positive integers only
                Case Asc("0") To Asc("9")
                Case Else
                        KeyAscii = 0
        End Select
End Sub

' =============================
' 2.3 Number #1 Text Change
Private Sub txtNumber1_Change()
            num1 = Val(txtNumber1)
            spnNumber1.Value = num1

                If optMultiply.Value = True Then
                        Call multiply1
                Else
                        Call divide1
                End If

End Sub

' =============================
' 2.4 Number #2 Spin Change
Private Sub SpnNumber2_Change()

        If txtNumber2.Text = "" Then
                spnNumber2.Value = 1
                num2 = 1
        End If

        txtNumber2.Text = spnNumber2.Value
        num2 = spnNumber2.Value

End Sub

' =============================
' 2.5 Number #2 Text KeyPress
Private Sub txtNumber2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Select Case KeyAscii
        ' Positive integers only
                Case Asc("0") To Asc("9")
                Case Else
                        KeyAscii = 0
        End Select
End Sub

' =============================
' 2.6 Number #2 Text Change
Private Sub txtNumber2_Change()
            num2 = Val(txtNumber2)
            spnNumber2.Value = num2
                If optMultiply.Value = True Then
                        Call multiply1
                Else
                        Call divide1
                End If
End Sub
' =============================
' ### End Input frame controls
' =============================
'

3. Result frame control events



Code 3: Sub txtResult_Change procedure
' =============================
' 3. Start Result frame controls
' =============================
Private Sub txtResult_Change()
    If Me.optMultiply Then
        txtResult.Text = txtResult.Text
    ElseIf Me.optDivide Then
        txtResult.Text = Format(txtResult.Text, "#,##0.000")
    End If
End Sub
' =============================
' ### End Result frame controls
' =============================
'

4. Output frame control events



Code 4:
' =============================
' 4. Start Output frame controls
' =============================
' 4.1 Output DropButtonClick
Private Sub txtoutputRange_DropButtonClick()
' The click event for the ReduceStyleDropButton
    On Error Resume Next
        Set outRange = Application.InputBox("Select range", "xlf DemoRefText", _
                                            ActiveCell.Address(), Type:=8)
        txtOutputRange.Text = outRange.Address
        If Not outRange Is Nothing Then cmdOutput.Enabled = True
    On Error GoTo 0
End Sub

' =============================
' 4.2 Output Click
Private Sub chkOutput_Click()

    If chkOutput = True Then
        lblOutput.Enabled = True
        txtOutputRange.Enabled = True
        'cmdOutput.Enabled = True
    Else
        lblOutput.Enabled = False
        txtOutputRange.Enabled = False
        cmdOutput.Enabled = False
    End If

End Sub
' =============================
' ### End Output frame controls
' =============================
'

5. Calculation engine code



Code 5: Sub multiply1 and Sub divide1 procedures
' =============================
' 5. Start calculation engine
' =============================
' 5.1 Multiply
Private Sub multiply1()

    If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then
        TxtResult.Text = num1 * num2
    End If

End Sub


' =============================
' 5.2 Divide
Private Sub divide1()

    If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then
        If num2 = 0 Then
            MsgBox "Division by zero", vbCritical, "Warning"
            TxtResult.Text = ""
        Else
            TxtResult.Text = Application.Round(num1 / num2, 3)
        End If
    End If

End Sub
' =============================
' ### End calculation engine
' =============================
'