Building a Feet Inches Sixteenths (FIS) Calculator in Excel
From a few years back … and recently updated.
My approach was simply:
- transform entries from FIS to decimal format
- do the math operations
- transform the results to FIS format
In the illustrated portion of this spreadsheet, the user can enter an FIS value, factor it (up, down, zero, negative, positive), produce a running sum of those entries. Red cells are user entries, blue cells are calculated.
Screenshot
Entering Fractions
' NOTES ' ' This excerpt is taken from my Excel VBA project code ' ' This subroutine is activated by any change to the worksheet ' ' In a certain range of cells, named "Fraction Groups" (see Column E), ' the user enters the fractional portion of a measurement without a slash ' ' EXAMPLE 1 ' To represent the fraction 1/2, the user types: 12 Enter ' A subroutine converts the integer 12 to a formula reading "= 1/2" ' ' EXAMPLE 2A ' To represent the fraction 3/16, the user types: 316 Enter ' A subroutine converts the integer 316 to a formula reading "= 3/16" ' ' EXAMPLE 2B ' To represent the fraction 3/16, the user types: 3 Enter ' A subroutine converts the integer 3 to a formula reading "= 3/16" ' ' The obvious benefit is an easy and definite entry of fractions without having to enter the slash ' Entering a slash in Excel typically triggers date entry mode -- not what I wanted '
First version
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim isect As Range
Set isect = Application.Intersect(Target, Range("Fraction_Groups"))
If Not (isect Is Nothing) Then
For Each cell In isect
cellVal = cell.Value
If cell.HasFormula = False And cellVal <> 0 And _
(cellVal - Int(cellVal)) = 0 Then
Select Case cellVal
'sixteenths (odd) no denominator'
Case 1, 3, 5, 7, 9, 11, 13, 15
cell.Formula = "= " & Str(cellVal) & " / 16"
'halves fourths and eighths'
Case 18, 14, 38, 12, 58, 34, 78, 28, 24, 48, 68
cell.Formula = "= " & Str(Int(cellVal / 10)) & " / " & _
Str(cellVal - Int(cellVal / 10) * 10)
'sixteenths (all)'
Case 116, 216, 316, 416, 516, 616, 716, 816, _
916, 1016, 1116, 1216, 1316, 1416, 1516
cell.Formula = "= " & Str(Int(cellVal / 100)) & " / " & _
Str(cellVal - Int(cellVal / 100) * 100)
End Select
ElseIf cell.Value = 0 Then
cell.Formula = ""
End If
Next cell
End If
Alternative version using VBA Mid() function
(seems cleaner)
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim isect As Range
Set isect = Application.Intersect(Target, Range("Fraction_Groups"))
If Not (isect Is Nothing) Then
For Each cell In isect
Cellval = cell.Value
If cell.HasFormula = False And Cellval <> 0 And _
(Cellval - Int(Cellval)) = 0 Then
Select Case Cellval
'sixteenths (odd) no denominator'
Case 1, 3, 5, 7, 9, 11, 13, 15
cell.Formula = "= " & Str(Cellval) & " / 16"
'halves fourths and eighths'
Case 18, 14, 38, 12, 58, 34, 78, 28, 24, 48, 68
cell.Formula = MFX(Str(Cellval))
'sixteenths (all)'
Case 116, 216, 316, 416, 516, 616, 716, 816, _
916, 1016, 1116, 1216, 1316, 1416, 1516
cell.Formula = MFX(Str(Cellval))
End Select
ElseIf cell.Value = 0 Then
cell.Formula = ""
End If
Next cell
End If
End Sub
Function MFX(inpx As String)
'VBA Mid() function version
'strip the blank characters
x = Replace(inpx, " ", "")
qlen = Len(x)
If qlen = 0 Then
MFX = "= 0"
ElseIf qlen = 1 Then
MFX = "= " & "/" & "16"
ElseIf qlen = 2 Then
MFX = "= " & Mid(x, 1, 1) & "/" & Mid(x, 2, 1)
ElseIf (qlen = 3) Or (qlen = 4) Then
MFX = "= " & Mid(x, 1, qlen - 2) & "/" & Mid(x, qlen - 1, 2)
Else
MFXS = x
End If
End Function
Errors and Warnings
Similar Triangle Solutions
.svg)
