Using Do-While Loop to return a value based on a range of inputs returns unexpected results

chirp08

New Member
Joined
Oct 7, 2015
Messages
7
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

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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,215,657
Messages
6,126,062
Members
449,286
Latest member
Lantern

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top