Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
return text from number
- Thread starter xhaya
- Start date
Nelviticus
Programmer
No, you'd have to write your own function. If you only want to convert a small range of numbers (like dates in a month) you can write a long 'Select Case' statement, otherwise the only way to do it is to write a clever algorithm that translates it into English. It'll be pretty complicated though.
You could do a search on the web for something like "translate decimal to english", someone has probably already done it. It doesn't matter if it's not in VBA, you can just borrow their logic.
N.
You could do a search on the web for something like "translate decimal to english", someone has probably already done it. It doesn't matter if it's not in VBA, you can just borrow their logic.
N.
DaleWatson123321
Programmer
Hi xhaya,
The following might be the custom function you're looking for...
It's (currently) set up to display dollars and cents, which is a common situation where numbers need to be converted to "spelled out numbers".
I suspect you might be looking to use this "as is" - i.e. for spelling out currency numbers. If not, you could modify the following code. If you do need to convert the code, please advise, and I or someone else will be pleased to assist you.
The code is below... You can (and should - to prevent typos) copy the code from below into a Module.
After copying the code, you can use the function: =spellnumber(A1). If A1 contain 53, then the result will currently be: Fifty Three Dollars and No Cents.
Another option - if you are dealing with currency is to modify the custom function this way...
=" $ "&spellnumber(A1)&" Only", which will give you:
$ Fifty Three Dollars and No Cents Only.
Reminder... In copying this, start with "Option Explicit", and end with "End Function".
Option Explicit
'================
' Main Function
'================
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
'String representation of number
MyNumber = Trim(Str(MyNumber))
'Position of decimal place - 0 if none
DecimalPlace = InStr(MyNumber, "."
'Converts cents and sets MyNumber to dollar amount
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
End Function
'===========================================
' Converts a number from 100-999 into text
'===========================================
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
'Converts to hundreds place
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
'Converts to tens and ones place
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
'===========================================
' Converts number from 10 to 99 into text
'===========================================
Function GetTens(TensText)
Dim Result As String
Result = "" 'null out temporary function value,
If Val(Left(TensText, 1)) = 1 Then 'if value between 10-19
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else 'if value between 20-99
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) 'get ones place
End If
GetTens = Result
End Function
'===========================================
' Converts number from 1 to 9 into text
'===========================================
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function
I hope this is what you were looking for. Please advise.
Regards, ...Dale Watson dwatson@bsi.gov.mb.ca
The following might be the custom function you're looking for...
It's (currently) set up to display dollars and cents, which is a common situation where numbers need to be converted to "spelled out numbers".
I suspect you might be looking to use this "as is" - i.e. for spelling out currency numbers. If not, you could modify the following code. If you do need to convert the code, please advise, and I or someone else will be pleased to assist you.
The code is below... You can (and should - to prevent typos) copy the code from below into a Module.
After copying the code, you can use the function: =spellnumber(A1). If A1 contain 53, then the result will currently be: Fifty Three Dollars and No Cents.
Another option - if you are dealing with currency is to modify the custom function this way...
=" $ "&spellnumber(A1)&" Only", which will give you:
$ Fifty Three Dollars and No Cents Only.
Reminder... In copying this, start with "Option Explicit", and end with "End Function".
Option Explicit
'================
' Main Function
'================
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
'String representation of number
MyNumber = Trim(Str(MyNumber))
'Position of decimal place - 0 if none
DecimalPlace = InStr(MyNumber, "."
'Converts cents and sets MyNumber to dollar amount
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
End Function
'===========================================
' Converts a number from 100-999 into text
'===========================================
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
'Converts to hundreds place
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
'Converts to tens and ones place
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
'===========================================
' Converts number from 10 to 99 into text
'===========================================
Function GetTens(TensText)
Dim Result As String
Result = "" 'null out temporary function value,
If Val(Left(TensText, 1)) = 1 Then 'if value between 10-19
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else 'if value between 20-99
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) 'get ones place
End If
GetTens = Result
End Function
'===========================================
' Converts number from 1 to 9 into text
'===========================================
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function
I hope this is what you were looking for.
Please advise.Regards, ...Dale Watson dwatson@bsi.gov.mb.ca
The last post's code is from for info
- Thread starter
- #5
- Status
Similar threads
- Locked
- Question
- Locked
- Helpful tip
- Locked
- Question
