User Form calculator (demonstration)
Calculator custom dialog box

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
' =============================
'
- Download: xlf-frmCalculator.xlsm [48 KB ]
- Development platform: Office 365 ProPlus - Excel 2016 MSO (16.0...) 64 bit
- Published: 20th May 2018
- Revised: Friday 24th of February 2023 - 02:38 PM, Pacific Time (PT)
