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

Comments

Post a Comment

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Add text fields- this VBA searches through the objects in the first frame until it finds " " in the text some where, truncates everything from and to the right and replaces it with an active countdown timer or current time in the box. Refreshes every 500ms with a prtsafe call so it doesn't bog down the CPU. Add a slide advance to start the next slide and begin automated slide advancement. Attribute VB_Name = "Countdown" Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long Public Sub Wait ( Seconds As Double ) ''non cpu-intensive wait timer '' https://stackoverflow.com/questions/57268161/sleep-wait-timer-in-powerpoint-vba-thats-not-cpu-intensive Dim endtime As Double endtime = DateTime.Timer + Seconds Do WaitMessage DoEvents Loop While DateTime.Timer < endtime End Sub Sub Countdown_from_Start () Dim Time As Date Dim Count As ...
Read more

Revit area plans adding new types and references (Gross and rentable)

Image
Note to self: Add additional (duplicate) gross area and net area schemed under Area Plans And Area schemes... Really counter-intuitive place to put this instead of say...  Area Plans> New Type> Edit Type (ADD) or Create an area plan, then Go to Properties, Edit Type and Duplicate... Always seem to forget this one! 2015-10-16-And for the calculation type... To update: this also applies to Revit as well as LT- The gross calculations cannot be overridden, however the 'rentable' comes in various flavors... From AD Revit help: Applies to Revit LT 2015 Rules are determined by one type of space bordering another space. The following table shows area measurement rules. To find the appropriate measurement rule, find the selected Area Type and the corresponding Bordering Area Type. Gross Building Area Scheme Types Gross Building Area Scheme Types Area Type Selected Bordering Area Type Measurement Rule Gross Building Area Gross Buil...
Read more