I'm working on a custom function that will return a value Y for input X depending on which range of values X falls into. The code I've come up with contains some nested functions to convert string inputs of English unit fractional dimensions (XX' x x/x") into decimal units (X.xx') and back to fractional units. The results I'm looking for are shown below:
0<x<2' 2" Y=X-2"
2' 2<=x<3' 10" Y=2' 0"
3' 10"<=x<5' 10" Y=3' 8"
5' 10"<=x<7' 10" Y=5' 8"
7' 10"<=x<9' 10" Y=7' 8"
9' 10"<=x<11' 10" Y=9' 8"
etc...
I realize I could accomplish this with a series of if/then statements, but wanted to try to clean up the code with a loop. I've done some VBA in the past but am very much a novice. Below is the code I came up with, and it performs as desired through every range except at an input of 7' 10". At this point, the function should be returning 7' 8" for Y, but it instead returns 5' 8". It performs as expected at all other similar transition points (ie, 3' 10"=3' 8", 5' 10"=5' 8", 9' 10"=9' 8", but 7' 10" doesn't work for some reason. I suspect it is due to an error in rounding between the two functions that are converting the fractional dimension strings to decimal inputs and back ("feet" & "LenText"), but I don't know how to track it down. Any help would be much appreciated. Below are the functions I'm using.
Barsizer function is the function that I'm having issues with
feet is a function that a previous employee must have copied from a Mr. Excel post at some point.
LenText is another function that a previous employee must have copied from a Mr. Excel post at some point.
0<x<2' 2" Y=X-2"
2' 2<=x<3' 10" Y=2' 0"
3' 10"<=x<5' 10" Y=3' 8"
5' 10"<=x<7' 10" Y=5' 8"
7' 10"<=x<9' 10" Y=7' 8"
9' 10"<=x<11' 10" Y=9' 8"
etc...
I realize I could accomplish this with a series of if/then statements, but wanted to try to clean up the code with a loop. I've done some VBA in the past but am very much a novice. Below is the code I came up with, and it performs as desired through every range except at an input of 7' 10". At this point, the function should be returning 7' 8" for Y, but it instead returns 5' 8". It performs as expected at all other similar transition points (ie, 3' 10"=3' 8", 5' 10"=5' 8", 9' 10"=9' 8", but 7' 10" doesn't work for some reason. I suspect it is due to an error in rounding between the two functions that are converting the fractional dimension strings to decimal inputs and back ("feet" & "LenText"), but I don't know how to track it down. Any help would be much appreciated. Below are the functions I'm using.
Barsizer function is the function that I'm having issues with
Code:
Public Function BarSizer(Width As String)
Dim BarInitial As String
If feet(Width) < feet("3' 10""") And feet(Width) > feet("2' 2""") Then
BarInitial = "2' 0"""
ElseIf feet(Width) <= feet("2' 2""") Then
BarInitial = LenText(feet(Width) - feet("2"""))
Else
BarInitial = "3' 8"""
Do While feet(Width) >= feet(BarInitial) + feet("2' 2""")
BarInitial = LenText(feet(BarInitial) + 2)
Loop
End If
BarSizer = BarInitial
End Function
feet is a function that a previous employee must have copied from a Mr. Excel post at some point.
Code:
Public Function feet(LenString As String)
Dim FootSign As Integer
Dim InchSign As Integer
Dim SpaceSign As Integer
Dim FracSign As Integer
Dim InchString As String
Dim Word2 As String
' Copyright 1999, 2005 MrExcel.com
LenString = Application.WorksheetFunction.Trim(LenString)
'The find function returns an error when the target is not found
'Resume Next will prevent VBA from halting execution.
On Error Resume Next
FootSign = Application.WorksheetFunction.Find("'", LenString)
If IsEmpty(FootSign) Or FootSign = 0 Then
' There are no feet in this expression
feet = 0
FootSign = 0
Else
feet = Val(Left(LenString, FootSign - 1))
End If
' Handle the case where the foot sign is the last character
If Len(LenString) = FootSign Then Exit Function
' Isolate the inch portion of the string
InchString = Application.WorksheetFunction.Trim(Mid(LenString, FootSign + 1))
' Strip off the inch sign, if there is one
InchSign = Application.WorksheetFunction.Find("""", InchString)
If Not IsEmpty(InchSign) Or InchSign = 0 Then
InchString = Application.WorksheetFunction.Trim(Left(InchString, InchSign - 1))
End If
' Do we have two words left, or one?
SpaceSign = Application.WorksheetFunction.Find(" ", InchString)
If IsEmpty(SpaceSign) Or SpaceSign = 0 Then
' There is only one word here. Is it inches or a fraction?
FracSign = Application.WorksheetFunction.Find("/", InchString)
If IsEmpty(FracSign) Or FracSign = 0 Then
'This word is inches
feet = feet + Val(InchString) / 12
Else
' This word is fractional inches
feet = feet + (Val(Left(InchString, FracSign - 1)) / Val(Mid(InchString, FracSign + 1))) / 12
End If
Else
' There are two words here. First word is inches
feet = feet + Val(Left(InchString, SpaceSign - 1)) / 12
' Second word is fractional inches
Word2 = Mid(InchString, SpaceSign + 1)
FracSign = Application.WorksheetFunction.Find("/", Word2)
If IsEmpty(FracSign) Or FracSign = 0 Then
' Return an error
feet = "VALUE!"
Else
If FracSign = 0 Then
feet = "VALUE!"
Else
feet = feet + (Val(Left(Word2, FracSign - 1)) / Val(Mid(Word2, FracSign + 1))) / 12
End If
End If
End If
End Function
LenText is another function that a previous employee must have copied from a Mr. Excel post at some point.
Code:
Public Function LenText(FeetIn As Double)
' This function will change a decimal number of feet to the text string
' representation of feet, inches, and fractional inches.
' It will round the fractional inches to the nearest 1/x where x is the denominator.
' Copyright 1999 MrExcel.com
Denominator = 8 ' must be 2, 4, 8, 16, 32, 64, 128, etc.
NbrFeet = Fix(FeetIn)
InchIn = (FeetIn - NbrFeet) * 12
NbrInches = Fix(InchIn)
FracIn = (InchIn - NbrInches) * Denominator
Numerator = Application.WorksheetFunction.Round(FracIn, 0)
If Numerator = 0 Then
FracText = ""
ElseIf InchIn >= (11 + (31.4999999 / 32)) Then
NbrFeet = NbrFeet + 1
NbrInches = 0
FracText = ""
ElseIf Numerator = Denominator Then
NbrInches = NbrInches + 1
FracText = ""
Else
Do
' If the numerator is even, divide both numerator and divisor by 2
If Numerator = Application.WorksheetFunction.Even(Numerator) Then
Numerator = Numerator / 2
Denominator = Denominator / 2
Else
FracText = " " & Numerator & "/" & Denominator
Exit Do
End If
Loop
End If
LenText = NbrFeet & "' " & NbrInches & FracText & """"
End Function