• Home
 · 
• Miscellaneous
 · 
• LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the v

LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the v

LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the variant variable. This one fixes that

Rate LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the v

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    Optional bAsCurrency As Boolean = False, Optional bShowWordNegative As Boolean = True, _
    Optional bDecimalInPoints As Boolean = False) As String
    '=======================================
    '     ========================================
    '     =====
    ' Can transform numeric values into corr
    '     esponding words
    ' - Handles scientific notation
    ' - Optional return value of currency fo
    '     rmat (dollars / cents)
    '=======================================
    '     ========================================
    '     =====
    '=======================================
    '     ========================================
    '     =====
    '
    ' Input Variables:
    ' Required: InNumber can be a string, ca
    '     lculation or numeric value
    ' Optional: sDecRetrun any string value
    '     (see Output below)
    ' Optional: bAsCurrency, if used, must b
    '     e True to return as currency (see Output
    '     below)
    ' Optional: bShowWordNegative, must be s
    '     et to False to prevent the word Negative
    '     being
    ' returned when the number passed to the


'     function is a negative number
    ' Optional: bDecimalInPoints, if used, m
    '     ust be True if decimal is to be returned
    '     in
    ' points (example: 3.5 is returned as Th
    '     ree Point Five) vs standard denomination
    '     s
    ' (i.e., /Tenths, etc) otherwise it is r
    '     eturned in points
    ' Note: the bAsCurrency boolean when set
    '     to True overrides this setting and decim
    '     al
    'values are always returned as cents
    '
    ' Output:
    ' WriteNumber will be the literal transl
    '     ation of the whole number passed to func
    '     tion
    ' sDecReturn will be the literal transla
    '     tion of the decimal number passed to fun
    '     ction
    ' bAsCurrency will return the whole numb
    '     er as dollars and the decimal as cents a
    '     nd the
    ' decimal will always be truncated to tw
    '     o places, otherwise decimal is
    ' returned as literal translation and de
    '     cimal value is .../Tenths, Hundredths, e
    '     tc...
    ' bShowWordNegative will return whether
    '     or not value sent is a negative number,
    '     and
    ' whether or not to include the word (ex
    '     : -2 normally returned as Negative Two)
    ' bDecimalInPoints will return decimal v
    '     alue like 3.5 as Three Point Five
    ' However, if bAsCurrency is set to True
    '     , then this boolean is not used
    '=======================================
    '     ========================================
    '     =====
    ' Variables used within function
    ' Following are strings used to translat
    '     e numbers to words
    ' sSegment is a group of 3 numbers sent


    '     for translation
        ' sDecimals is the decimal value of the
        '     number sent to function
        ' sNumbers is a string representation of
        '     the number sent to function
        ' sSource is a resuable value referencin
        '     g either sNumbers or sDecimals
        ' sNpart is used to final format the gro
        '     up of 3 numbers, including denominations
        '
        Dim sSegment As String, sDecimals As String, sSource As String, sNumbers As String
        ' sDenom is the denominations of the sDe
        '     cimals
        Dim sDeciDenom As String, sNrPart As String
        ' These are simple variables to loop thr
        '     u the groups of 3, & help format the InN
        '     umber value
        ' iOffset used interchangeably for diffe
        '     rent reason
        ' iHyphen indicates whether a word shoul
        '     d be hyphenated (like Twenty-Three)
        Dim Looper As Integer, I As Integer, iOffset As Integer, iHyphen As Integer, iByPts As Integer
        ' iST indicates whether or not the value
        '     passed is in scientific notation (like E
        '     +5)
        ' iEnr is the value after the scientific
        '     notation
        ' iEpos is the position in the string wh
        '     ere the scientific notation begins
        Dim iEnr As Integer, iEpos As Integer, iST As Integer, bIsNegative As Boolean

        On Error Resume Next
        If IsNumeric(InNumber) = False Then ' Abort if Not a numberic number
            WriteNumber = "Error - Passed invalid number " & InNumber
            Exit Function
        End If ' If number is too big or small, abort also
        On Error GoTo Function_Errors
        InNumber = Replace(InNumber, ",", "")
        If Val(InNumber) >= 10000# * 10 ^ 60 Or Val(InNumber) <= -10000# * 10 ^ 60 Then
            WriteNumber = "Extremely large or extremely small number!"
            Exit Function
        End If
        GoSub FormatInput ' Format the String as needed
        sSource = sNumbers


        For Looper = 1 To Len(sSource) Step 3 ' Start parsing the number
            sSegment = CStr(Val(Mid(sSource, Looper, 3))) ' Get the Next 3 characters
            GoSub DoConversion ' convert that To text
            WriteNumber = WriteNumber & sNrPart ' Concactenate the result
        Next
        WriteNumber = Trim(Replace(WriteNumber, " ", " ")) ' remove Double spaces, If any
        ' remove any trailing comma's if needed
        If Right(WriteNumber, 1) = "," Then WriteNumber = Left(WriteNumber, Len(WriteNumber) - 1)
        ' if negative and user wants the word ne
        '     gative returned, then add it to the retu
        '     rn
        If bShowWordNegative = True And bIsNegative = True Then WriteNumber = "Negative " & WriteNumber
        bShowWordNegative = bIsNegative ' Return whether value is negative or Not
        ' if user wants this displayed in curren
        '     cy then add the word Dollars
        If bAsCurrency = True Then WriteNumber = WriteNumber & " Dollars"
        ' Process decimal values, if any
        sSource = sDecimals


        If bAsCurrency = True Or bDecimalInPoints = False Then
            iByPts = 3
        Else
            iByPts = 1
        End If


        If Val(sSource) > 0 Then


            For Looper = 1 To Len(sSource) Step iByPts ' Start parsing the number
                sSegment = CStr(Val(Mid(sSource, Looper, iByPts))) ' Get the Next 3 characters
                GoSub DoConversion ' convert that To text
                sDecReturn = sDecReturn & sNrPart ' Concactenate the result
            Next
            sDecReturn = Trim(Replace(sDecReturn, " ", " ")) ' remove Double spaces, If any


            If iByPts = 1 Then ' Decimal value To be returned word by word, so remove commas
                sDecReturn = Replace(sDecReturn, ",", "")
            Else ' remove any leading comma's If needed
                If Left(sDecReturn, 1) = "," Then sDecReturn = Mid(sDecReturn, 2)
            End If


            If bAsCurrency = True Then ' if returning currency,
                sDecReturn = sDecReturn & " Cents" ' Then add Cents
            Else ' otherwise add default


                If iByPts = 1 Then ' word by word?
                    sDecReturn = "Point " & sDecReturn ' yep, so add the word Point
                Else
                    sDecReturn = sDecReturn & sDeciDenom ' nope, so add the default denomination
                End If
            End If
        End If
        Exit Function
        '=======================================
        '     ========================================
        '     =========
        'SUB-ROUTINES
        '=======================================
        '     ========================================
        '     =========


DoConversion:
            sNrPart = "": iOffset = 1 ' Initialize variables


            If iByPts = 1 Then ' When this is Set To one, then two things are happening...
                GoSub MakeSingle ' 1) Decimals are being checked & 2) bDecimalInPoints = True
                Return ' So, return Single word format
            End If


            For I = 1 To Len(sSegment) ' Start translating one character at a time


                Select Case Val(sSegment)
                    Case Is > 99 ' Number is 3-long, so always using hundreds here
                    GoSub MakeSingle ' Get the numeric value of 1, 2, 3 etc
                    sNrPart = sNrPart & " Hundred" ' Include the word Hundred
                    Case Is > 19 ' Number is In the tens, so format appropriately
                    sNrPart = sNrPart & Choose(Left(sSegment, 1) - 1, " Twen", " Thir", " For", " Fif", " Six", " Seven", " Eigh", " Nine") & "ty"
                    If Val(Right(sSegment, 1)) Then iHyphen = 1 ' If Not even tens, hyphenate the result
                    Case Is > 9 ' Number is In teens, so format appropriately


                    Select Case Val(sSegment)
                        Case 16, 17, 18, 19: sNrPart = sNrPart & Choose(Val(sSegment) - 15, " Sixteen", " Seventeen", " Eighteen", " Nineteen")
                        Case 13, 14, 15: sNrPart = sNrPart & Choose(Val(sSegment) - 12, " Thirteen", " Fourteen", " Fifteen")
                        Case 10, 11, 12: sNrPart = sNrPart & Choose(Val(sSegment) - 9, " Ten", " Eleven", " Twelve")
                    End Select
                Exit For ' force Loop To finish
                Case Is > 0
                GoSub MakeSingle ' Single numbers Get literal traslation
                Case 0 ' Only display word Zero when value of entire number is zero
                ' when first iteration thru loop and val
                '     ue of string passed is zero
                If Looper = Len(sSource) - 2 And Val(sSource) = 0 Then sNrPart = "Zero"
            End Select
        sSegment = Mid(sSegment, 2) ' strip off character processed & continue looping
    Next
    ' Now to finish formatting this group of
    '     3


    If Trim(Len(sNrPart)) Then ' But only if something was initially formatted
        ' When not on the last group of 3, add t
        '     he denomination
        If Looper < Len(sSource) - 2 Then GoSub AddDenom
        ' When not on the first group of 3, prec
        '     ed final formatting with a comma
        If Looper < Len(sSource) And Looper > 1 Then sNrPart = ", " & sNrPart
    End If
    Return
MakeSingle:     ' Converts numbers 1-9 To words & precedes it With a space or hyphen as needed
    sNrPart = sNrPart & Choose(iHyphen + 1, " ", "-") & Choose(Mid(sSegment, iOffset, 1) + 1, "Zero", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    iOffset = 1: iHyphen = 0 ' Reset these variables
    Return
AddDenom:     ' Adds denomination To whole portion of the number
    ' Formula to determine how many zeros ar
    '     e in the entire number
    iOffset = Int((Len(sSource) / 3) - (Int(Looper / 3)) + 1)


    Select Case iOffset ' add the denomination as needed To the final format
        Case 3, 4, 5: sNrPart = sNrPart & Choose(iOffset - 2, " Thousand ", " Million ", " Billion ")
        Case 6, 7: sNrPart = sNrPart & Choose(iOffset - 5, " Trillion ", " Quadrillion ")
        Case 8, 9, 10, 11: sNrPart = sNrPart & Choose(iOffset - 7, " Quni", " Sex", " Sep", " Oct") & "tillion "
        Case 12, 13: sNrPart = sNrPart & Choose(iOffset - 11, " Nonillion ", " Decillion ")
        Case 14, 15, 16: sNrPart = sNrPart & Choose(iOffset - 13, " Un", " Duo", " Tre") & "tillion "
        Case 17, 18, 19: sNrPart = sNrPart & Choose(iOffset - 16, " Quattuor", " Quin", " Sex") & "tillion "
        Case 20, 21, 22: sNrPart = sNrPart & Choose(iOffset - 19, " Septen", " Octo", " Novem") & "tillion "
    End Select
sNrPart = Trim(sNrPart) ' trim off any extra spaces
Return
AddDecimalDenom: ' Adds denominations To decimal portion of number
sSource = sDecimals ' Set source For comparison
Looper = -1: sNrPart = "" ' Valuables force conversion for decimals, diffently from whole numbers
GoSub AddDenom ' Get the Decimal denomination
sDeciDenom = sNrPart ' Set variable initially
' Determine whether this will be a whole
'     denomination or parts of a denomination.
'     ...
' is this thousandths, ten-thousandths o
'     r hundred-thousandths?
iOffset = Len(sDecimals) Mod 3


Select Case iOffset
Case 0: ' multiples of 3, formatting is correct
Case 1, 2: ' tens of..., hundreds of...
' the denomination sub above does not ha
'     ndle tenths & hundredths so we handle it
'     here


If Len(sDecimals) < 3 Then ' then were looking at decimals like .3 or .26
    sDeciDenom = Choose(Len(sDecimals), "Ten", "Hundred")
Else ' otherwise were looking at denominations between major divisions, like
    ' ten-thousandths, or hundred-thousandth
    '     s vs. simple thousandths
    sDeciDenom = Choose(iOffset, "Ten-", "Hundred-") & sDeciDenom
End If
End Select
sDeciDenom = "/" & sDeciDenom & "ths" ' finish the variable
Return


FormatInput: ' Subroutine formats the InNumber for parsing
sNumbers = CStr(Val(InNumber))


If Left(sNumbers, 1) = "-" Then ' is this a negative number?
bIsNegative = True ' yep, so track that fact
sNumbers = Mid(sNumbers, 2) ' now strip the minus sign off
End If
I = InStr(sNumbers, ".") ' Does this have a Decimal point in the number?
' if not then the number is not in Scien
'     tific notation, otherwise it could be


If InStr(sNumbers, "E") > 0 Then 'Formatting Scientfic notation
' Keep location of the E+/-## and the va
'     lue of the ## after E+/- if provided
iEpos = InStr(sNumbers, "E") ' If Not provided, Set iEpos To Decimal position
iEnr = Val(Mid(sNumbers, iEpos + 1))
' Keep any numbers before the decimal po
'     int & set another variable to everything
'     after


If I > 0 Then
    sNrPart = Left(sNumbers, I - 1): sSegment = Mid(sNumbers, I + 1)
Else
    sNrPart = Left(sNumbers, iEpos - 1)
End If


If iEnr <> 0 Then ' Should never = 0, but just In Case check it - you never know
    ' Add extra zeros (the vaue of ## ) at e
    '     nd or beginning of string


    If bIsNegative Then ' gotta add numbers To beginning of value
        ' strip any leading zeros from whole num
        '     ber, otherwise negative notation will fa
        '     il


        Do While Left(sSegment, 1) = "0"
            sSegment = Mid(sSegment, 2) ' Remove any trailing zeros from the Decimal value
        Loop
        sSegment = String$(Abs(iEnr - 1), "0") & Left(sSegment, iEpos - 1)
        sDecimals = Mid(sSegment, Abs(iEnr) + 1) ' Extract what would be the decimal value
        sSegment = Left(sSegment, Abs(iEnr)) ' Now save what's To the left of the Decimal
    Else ' gotta add numbers To End of value
        sSegment = Left(sSegment, iEpos - 1) & String$(iEnr, "0")
        sDecimals = Mid(sSegment, iEnr + 1) ' Extract what would be the decimal value
        sSegment = Left(sSegment, iEnr) ' Now save what's To the left of the Decimal
    End If
Else ' Oops, E+/-0 was passed, so
    sDecimals = Mid(sNumbers, I + 1) ' Extract what would be the decimal value
    sSegment = Left(sNumbers, iEpos - 1) ' Save what's To the left of the Decimal
End If
Else ' no E+/- scientific notation found


If I > 0 Then ' does value have decimals anyway?
    sDecimals = Mid(sNumbers, I + 1) ' yep, so extract the decimal value
    sSegment = Left(sNumbers, I - 1) ' save what's To the left of the Decimal
Else
    sSegment = sNumbers
End If
End If
sSegment = sNrPart & sSegment ' Put the whole number back together
' Since formating may have placed exra z
'     eros at end of decimals, strip them now


Do While Right(sDecimals, 1) = "0"
sDecimals = Left(sDecimals, Len(sDecimals) - 1) ' Remove any trailing zeros from the decimal value
Loop


If bAsCurrency = True Then
sDecimals = Mid(Format("." & sDecimals, ".00"), 2)
Else


If bDecimalInPoints = False Then
    GoSub AddDecimalDenom
    ' Now add leading zeros to force the str
    '     ing to a mulitple of 3
    sDecimals = Choose((Len(sDecimals) Mod 3) + 1, "", "00", "0") & sDecimals
End If
End If
' Now add leading zeros to force the str
'     ing to a mulitple of 3
sNumbers = Choose((Len(sSegment) Mod 3) + 1, "", "00", "0") & sSegment
Return


Function_Errors:
    WriteNumber = Err.Description
End Function