by LaVolpe (66 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 9th June 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the variant variable. This one fixes that
VBcoders
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
No comments have been posted about LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the v. Why not be the first to post a comment about LaVolpe Number to Text Converter (II). Previous code was not accepting commas when passed via the v.
