by LaVolpe (66 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 9th June 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Know what a number is called when it has 60 zeros? Convert any number to the power of 62 to words. Optional formating for currency and
VBcoders
Optional bAsCurrency As Boolean = False, Optional bShowWordNegative As Boolean = True, _
Optional bDecimalInPoints As Boolean = False) As String
'====================================================================================
' Can transform numeric values into corresponding words
' - Handles scientific notation
' - Optional return value of currency format (dollars / cents)
'====================================================================================
'====================================================================================
'
' Input Variables:
' Required: InNumber can be a string, calculation or numeric value
' Optional: sDecRetrun any string value (see Output below)
' Optional: bAsCurrency, if used, must be True to return as currency (see Output below)
' Optional: bShowWordNegative, must be set to False to prevent the word Negative being
' returned when the number passed to the function is a negative number
' Optional: bDecimalInPoints, if used, must be True if decimal is to be returned in
' points (example: 3.5 is returned as Three Point Five) vs standard denominations
' (i.e., /Tenths, etc) otherwise it is returned in points
' Note: the bAsCurrency boolean when set to True overrides this setting and decimal
' values are always returned as cents
'
' Output:
' WriteNumber will be the literal translation of the whole number passed to function
' sDecReturn will be the literal translation of the decimal number passed to function
' bAsCurrency will return the whole number as dollars and the decimal as cents and the
' decimal will always be truncated to two places, otherwise decimal is
' returned as literal translation and decimal value is .../Tenths, Hundredths, etc...
' 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 value 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 translate 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 referencing either sNumbers or sDecimals
' sNpart is used to final format the group of 3 numbers, including denominations
Dim sSegment As String, sDecimals As String, sSource As String, sNumbers As String
' sDenom is the denominations of the sDecimals
Dim sDeciDenom As String, sNrPart As String
' These are simple variables to loop thru the groups of 3, & help format the InNumber value
' iOffset used interchangeably for different reason
' iHyphen indicates whether a word should 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 where the scientific notation begins
Dim iEnr As Integer, iEpos As Integer, iST As Integer, bIsNegative As Boolean
On Error GoTo Function_Errors
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
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 negative returned, then add it to the return
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 currency 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 value 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 the denomination
If Looper < Len(sSource) - 2 Then GoSub AddDenom
' When not on the first group of 3, preced 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 are 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 - 8, " 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 or 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 handle 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-thousandths 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 Scientific notation, otherwise it could be
If InStr(sNumbers, "E") > 0 Then 'Formatting Scientfic notation
' Keep location of the E+/-## and the value 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 point & 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 end or beginning of string
If bIsNegative Then ' gotta add numbers to beginning of value
' strip any leading zeros from whole number, otherwise negative notation will fail
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 - 1, "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 zeros 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 string 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 string 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 Know what a number is called when it has 60 zeros? Convert any number to the power of 62 to words. . Why not be the first to post a comment about Know what a number is called when it has 60 zeros? Convert any number to the power of 62 to words. .
