Wednesday, May 16, 2012

Excel functions to understand feet and inches input

Option Explicit

Public Function FT_DECI(Feet_STRING As String) As Variant
    Dim WORK_VARIANT
    Dim I As Integer
    Dim nchar As String
    Dim IsNegative As Boolean
    ''INITIALIZE WORK_VARIANT
    WORK_VARIANT = ""
    Feet_STRING = Trim(Feet_STRING)
   
    ''strip off leading alpha characters
    For I = 1 To Len(Feet_STRING)
        Select Case Mid(Feet_STRING, I, 1)
            Case "0" To "9"
                Exit For
            Case "-"
                IsNegative = True
        End Select
    Next I
   
    Feet_STRING = Trim(Right(Feet_STRING, Len(Feet_STRING) - I + 1))
   
    ''cleanup format string
    For I = 1 To Len(Feet_STRING)
        nchar = UCase(Mid(Feet_STRING, I, 1))
        Select Case nchar
            Case "0" To "9", "'", "."  '''''''<<<<<<<<<<<<<DEBUG "." Added
                WORK_VARIANT = WORK_VARIANT & nchar
            Case "\"
                WORK_VARIANT = WORK_VARIANT & "/"
            Case "F"
                WORK_VARIANT = WORK_VARIANT & "'"     ''replace starting f or ft or feet with ' mark
            Case "I", """"
                If Right(WORK_VARIANT, 1) <> """" Then WORK_VARIANT = WORK_VARIANT & """"
            Case " ", "-", "/"
                If Len(WORK_VARIANT) > 0 _
                   And Right(WORK_VARIANT, 1) <> " " _
                Then
                   WORK_VARIANT = WORK_VARIANT & " "
                End If
        End Select
    Next
   
    '''rightmost should be a double quote
    ''If Right(WORK_VARIANT, 1) <> """" Then WORK_VARIANT = WORK_VARIANT & """"
    If InStr(1, WORK_VARIANT, "'") > 0 Then
        WORK_VARIANT = Split(WORK_VARIANT, "'")             'split out feet and inches
        If UBound(WORK_VARIANT) > 1 Then GoTo FT_DECI_ERR   ''if too many ft references error out
        ''set whole feet
        FT_DECI = Val(WORK_VARIANT(0))  ''set feet
        WORK_VARIANT = WORK_VARIANT(1)  ''set remainder
       
    End If
   
    ''format remaining fraction
    WORK_VARIANT = Split(Trim(WORK_VARIANT), " ")
   
    ''check to see if there are too many placeholders - if no FEET have been defined we are ok.
    ''*note: split uses base-Zero arrays
    If UBound(WORK_VARIANT) > 2 And FT_DECI > 0 Then GoTo FT_DECI_ERR
    ''if feet are not defined we can have 4 placeholders
    If UBound(WORK_VARIANT) > 3 Then GoTo FT_DECI_ERR
   
    Select Case UBound(WORK_VARIANT)
        Case 1 ''two entries assumed to be fractional inches
            FT_DECI = FT_DECI + Val(WORK_VARIANT(0)) / Val(WORK_VARIANT(1)) / 12
        Case 2 '' three entries assumes whole and fractional inches
            FT_DECI = FT_DECI + (Val(WORK_VARIANT(0)) + Val(WORK_VARIANT(1)) / Val(WORK_VARIANT(2))) / 12
        Case 3 '' if deci_ft is still 0 then no feet have been set so assumes ft inch fractional inch format
            FT_DECI = Val(WORK_VARIANT(0)) + (Val(WORK_VARIANT(1)) + Val(WORK_VARIANT(2)) / Val(WORK_VARIANT(3))) / 12
        Case Else
            GoTo FT_DECI_ERR
    End Select

GoTo FT_DECI_EXIT
FT_DECI_ERR:
    FT_DECI = CVErr(xlErrNA)
    Exit Function
FT_DECI_EXIT:
    If IsNegative Then FT_DECI = -FT_DECI
End Function

Public Function FtIn(FEET_DBL As Double, Optional Fractional_Denominator_Tolerance As Integer)
    ' This function will change a decimal number of feet to the text string
    ' representation of feet, inches, and fractional inches.
    ' ROUNDS BASED ON Fractional_Denominator_Tolerance
   
    Dim RMDR As Double                  '' REMAINDER OF DECIMAL FEET AS FEET, INCHES AND FRACTIONAL INCES ARE SUBTRACTED
    Dim FEET_INT  As Integer            '' INTEGER FEET
    Dim INCH_INT As Integer             '' INTEGER INCHES
    Dim INCH_NUMERATOR_INT As Integer   '' FRACTIONAL INCHES NUMERATOR
    Dim DENOMINATOR As Integer          '' DENOMINATOR FOR FRACTIONAL INCHES
    ''Denominator= must be 2, 4, 8, 16, 32, 64, 128, etc.
    RMDR = FEET_DBL

    Select Case Fractional_Denominator_Tolerance
        Case 2, 4, 8, 16, 32, 64, 128, 256  ''ADD MORE IF YOU WANT TO- NEEDS TO BE MULTIPLE OF 2
            DENOMINATOR = Fractional_Denominator_Tolerance
        Case 0                              ''UNSPECIFIED CASE - DEFAULT TO ROUNDING TO THE NEAREST 1/8"
            DENOMINATOR = 8
        Case Else
            DENOMINATOR = 1                 ''OTHERWISE ROUND TO THE NEAREST INCH
    End Select
   
    FEET_INT = Fix(RMDR)
    RMDR = (RMDR - FEET_INT) * 12 ''SUBTRACT WHOLE FEET- MULTIPLY FOR FRACTIONAL INCHES
    INCH_INT = Fix(RMDR)
    RMDR = (RMDR - INCH_INT) * DENOMINATOR
    INCH_NUMERATOR_INT = Fix(RMDR + 0.5) ''rounds with the .5 added
   
    If INCH_NUMERATOR_INT = DENOMINATOR Then ''ROUND BUMPED UP TO WHOLE INCH
        INCH_NUMERATOR_INT = 0  ''REMOVE THE FRACTIONAL INCHES (E.G. 8/8)
        INCH_INT = INCH_INT + 1 ''ADD IT TO THE INCHES
    End If
   
    ''PROPER FRACTIONAL conversion so 6/8 is 3/4
    Do While Fix(INCH_NUMERATOR_INT / 2) = INCH_NUMERATOR_INT / 2 And DENOMINATOR / 2 > 1
        INCH_NUMERATOR_INT = INCH_NUMERATOR_INT / 2
        DENOMINATOR = DENOMINATOR / 2
    Loop
   
    FtIn = FEET_INT & "' " & INCH_INT
       
    If INCH_NUMERATOR_INT > 0 Then  ''FRACTIONAL INCHES
        FtIn = FtIn & " " & INCH_NUMERATOR_INT & "/" & DENOMINATOR
    End If
    ''ADD INCHES MARK
     FtIn = FtIn & """"
End Function

No comments:

Post a Comment