Question Convert number to english word (1 Viewer)

emphyda

Registered User.
Local time
Today, 18:45
Joined
Jun 2, 2013
Messages
12
Sorry folks for being away this while. I came across the code below in the internet and would want to use it in my application.
I do have a little challenge with it. In my part of globe, we spell numbers, for example 1001 to read "One thousand and one"
Here is the code

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 amount
MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none
DecimalPlace = InStr(MyNumber, ".")
'Convert cents and set 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)

'Convert the hundreds place
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If

'Convert the 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 a number from 10 to 99 into text. *
'*********************************************
Function GetTens(TensText)
Dim Result As String

Result = "" 'null out the 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)) 'Retrieve ones place
End If
GetTens = Result
End Function

'*******************************************
' Converts a 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
My question is where in the lines do I instruct it to put "And" in writing numbers like 1010, 1099 etc to read "One thousand And ten", "One thousand And Ninety-Nine"
I need the solution very urgently. Somebody help pleeeaase.
Regards...
Emphyda.
 

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
Is this what you expect/need from SpellNumber(3007902.99)?

Three Million and Seven Thousand and Nine Hundred and Two Dollars and Ninety Nine Cents

and

SpellNumber(1255733007902.99) gives
One Trillion and Two Hundred and Fifty Five Billion and Seven Hundred and Thirty Three Million and Seven Thousand and Nine Hundred and Two Dollars and Ninety Nine Cents

If so, then these were the changes --notice the " and "


In Spellnumber -main
10 ReDim place(9) As String
20 place(2) = " Thousand and "
30 place(3) = " Million and "
40 place(4) = " Billion and "
50 place(5) = " Trillion and "

In GetHundreds
30 If Mid(MyNumber, 1, 1) <> "0" Then
40 Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred and "
50 End If


My Test routine

Code:
Sub testSpellNumber()

     
10    Debug.Print SpellNumber(1255733007902.99)
End Sub
 
Last edited:

emphyda

Registered User.
Local time
Today, 18:45
Joined
Jun 2, 2013
Messages
12
Thanks for the responses. The solution from J draw is closer to my expectation but the "And" must come for tens and units part of the number. Using your example,
SpellNumber(3007902.99) will read Three Million Seven Thousand Nine Hundred and two dollars Ninety-Nine cents.
I want for example,
SpellNumber(3007002) to read Three Million Seven Thousand And Two Dollars.
Emphyda.
 

RuralGuy

AWF VIP
Local time
Today, 11:45
Joined
Jul 2, 2005
Messages
13,826
I think this will do it.
Code:
Option Compare Database
Option Explicit

Dim Count As Integer          '-- Made Global

'****************
' Main Function *
'****************
Function SpellNumber(ByVal MyNumber)
   Dim Dollars, Cents, Temp
   Dim DecimalPlace

   ReDim Place(9) As String
   Place(2) = " Thousand "
   Place(3) = " Million "
   Place(4) = " Billion "
   Place(5) = " Trillion "

   ' String representation of amount
   MyNumber = Trim(Str(MyNumber))

   ' Position of decimal place 0 if none
   DecimalPlace = InStr(MyNumber, ".")
   'Convert cents and set 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
      End If
      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)

   'Convert the hundreds place
   If Mid(MyNumber, 1, 1) <> "0" Then
      Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
   End If

   'Convert the tens and ones place
   If Mid(MyNumber, 2, 1) <> "0" Then
      Result = Result & GetTens(Mid(MyNumber, 2))
   Else
      If Count = 1 Then
         Result = "and " & Result & GetDigit(Mid(MyNumber, 3))
      Else
         Result = Result & GetDigit(Mid(MyNumber, 3))
      End If
   End If

   GetHundreds = Result
End Function

'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Function GetTens(TensText)
   Dim Result As String
   Dim PreResults As String
   
   If Count = 1 Then                                                          '-- Added
      '-- This is the < 1000 group and we know the value is between 1 and 99
      '-- so prepend and "and" to the result.
      PreResults = "and "                                                     '-- Added
   Else
      PreResults = "" 'null out the temporary function value                  '-- Changed
   End If
   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 = PreResults & Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place --- CHANGED
   End If
   GetTens = Result
End Function

'*******************************************
' Converts a 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
 
Last edited:

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
I've kept the changes I made, but adjusted my test routine
Code:
Sub testSpellNumber()

    Dim astr, hold, i As Integer, x As String
    astr = 390102792.57
10  hold = Split(SpellNumber(astr), " and ")
    For i = UBound(hold) - 2 To UBound(hold) - 1
        hold(i) = hold(i) & " and "
    Next i
    For i = LBound(hold) To UBound(hold)
        x = x & hold(i) & " "
    Next i
    Debug.Print x
End Sub

which yields

Three Hundred Ninety Million One Hundred Two Thousand Seven Hundred and Ninety Two Dollars and Fifty Seven Cents


It should be done in the function. But this shows what is being changed.
There are always 2 ands at the end (at least that's my understanding).
 

emphyda

Registered User.
Local time
Today, 18:45
Joined
Jun 2, 2013
Messages
12
Thanks RuralGuy but I still have problems with numbers like 1 which reads "and one", 100 reads " and one hundred .
 

RuralGuy

AWF VIP
Local time
Today, 11:45
Joined
Jul 2, 2005
Messages
13,826
Sorry there Emphyda, does jdraw's work as you expect?
 

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
Emphyda,

I think we need more info.
What do you expect as a result for? (and there may be more)

1
1.00
10
100
101
101.88

My guess is that you have to look for patterns and find a solution(s) based on those patterns.
If you are not dealing with currency, then dollars and cents doesn't fit the general pattern.
Are you dealing with both plain numbers and currency?

If you have 1000000 (1 million) there are no "ands". So it seems there must be logic to see if you are dealing with Currency or not.

In my latest sample using 39000000 as the number, the result is
Thirty Nine Million and Dollars and No Cents which does not read properly whether currency or not.
So we need to see more conditions/patterns and work from those.

Good luck.
 

sneuberg

AWF VIP
Local time
Today, 10:45
Joined
Oct 17, 2014
Messages
3,506
I do have a little challenge with it. In my part of globe, we spell numbers, for example 1001 to read "One thousand and one"

What part of the globe would that be and is the target language English?
 

emphyda

Registered User.
Local time
Today, 18:45
Joined
Jun 2, 2013
Messages
12
My part of globe is Nigeria in West Africa. I am developing a retail application for retail and small size businesses. In Nigeria, our currency is Naira and Kobo. We translate numbers currency to English using "and" in this manner,
100 reads one hundred.
123 reads one hundred and twenty three.
1090 reads one thousand and ninety.
102590 reads one hundred and two thousand five hundred and ninety
1001 reads one thousand and one. etc
Hope you get my trend.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 18:45
Joined
Feb 19, 2013
Messages
16,639
can't offer any specific advice but have you googled for 'cheque writing algorithms'? - found this example

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=39627&lngWId=1.

it only converts longs, but should be easy to add the cents aspect

at least you can try your different numbers to see if it works as you require before fiddling with it.

Note - my virus checker won't let me download without reducing my trust settings, which I'm not prepared to do - so up to you:)
 

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
I found another function and did some minor adjustments, but it deals with currency.

Note: I have adjusted this post with revised code.

Code:
'---------------------------------------------------------------------------------------
' Procedure : Convert
' Author    : mellon
' Date      : 31-Oct-2016
' Purpose   : Copied from
'http://msaccessvb.blogspot.ca/2011/02/number-to-words-conversion-with-ms.html
'and adjusted to deal with dollars and cents from Pesos and Centavos

'---------------------------------------------------------------------------------------
'
Function Convert(ByVal mAmount As String)
          Dim mDec As Variant, mDecWhat As String, mNumberOfDigits, mCntr, Word, OneD, TwoD, mInput
10        On Error GoTo Convert_Error

20        mInput = Format(mAmount, "####0.00")
30        OneD = Array("", "One ", "Two ", "Three ", "Four ", "Five ", "Six ", "Seven ", "Eight ", "Nine ", "Ten ", "Eleven ", "Twelve ", "Thirteen ", "Fourteen ", "Fifteen ", "Sixteen ", "Seventeen ", "Eighteen ", "Nineteen ")
40        TwoD = Array("", "Ten ", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
50        mDec = InStr(1, mInput, ".", 1)
60        If mDec = 0 Then mAmount = mInput    'no decimal
70        If mDec <> 0 Then mDecWhat = Right(mInput, Len(mInput) - mDec): mAmount = mInput: mInput = Mid(mInput, 1, mDec - 1)
80        If Len(mInput) > 12 Then Exit Function
90        If Len(mInput) <= 3 Then mNumberOfDigits = Array(mInput, "", "", "")
100       If Len(mInput) >= 4 And Len(mInput) <= 6 Then mNumberOfDigits = Array(Mid(mInput, 1, Len(mInput) - 3), Right(mInput, 3), "", "")
110       If Len(mInput) >= 7 And Len(mInput) <= 9 Then mNumberOfDigits = Array(Mid(mInput, 1, Len(mInput) - 6), Mid(mInput, Len(mInput) - 5, 3), Right(mInput, 3), "")
120       If Len(mInput) >= 10 And Len(mInput) <= 12 Then mNumberOfDigits = Array(Mid(mInput, 1, Len(mInput) - 9), Mid(mInput, Len(mInput) - 8, 3), Mid(mInput, Len(mInput) - 5, 3), Right(mInput, 3))
130       For mCntr = 0 To IIf(Len(mInput) <= 3, 0, IIf(Len(mInput) >= 4 And Len(mInput) <= 6, 1, IIf(Len(mInput) >= 7 And Len(mInput) <= 9, 2, IIf(Len(mInput) >= 10 And Len(mInput) <= 12, 3, 0))))
140           If Len(mNumberOfDigits(mCntr)) = 3 Then
150               Word = Word & OneD(val(Left(mNumberOfDigits(mCntr), 1))) & IIf(Left(mNumberOfDigits(mCntr), 1) <> "0", "Hundred", "")
160               If Mid(mNumberOfDigits(mCntr), 2, 2) <= 19 Then Word = Word & " " & OneD(val(Mid(mNumberOfDigits(mCntr), 2))) Else If Mid(mNumberOfDigits(mCntr), 2, 1) >= 1 Then Word = Word & " " & TwoD(val(Mid(mNumberOfDigits(mCntr), 2, 1))) & IIf(Right(mNumberOfDigits(mCntr), 1) >= 1, OneD(Right(mNumberOfDigits(mCntr), 1)), "")
170           ElseIf Len(mNumberOfDigits(mCntr)) = 2 Then
180               If val(mNumberOfDigits(mCntr)) <= 19 Then Word = Word & " " & OneD(val(mNumberOfDigits(mCntr))) Else If val(mNumberOfDigits(mCntr)) >= 2 Then Word = Word & " " & TwoD(val(Left(mNumberOfDigits(mCntr), 1))) & IIf(Right(mNumberOfDigits(mCntr), 1) >= 1, OneD(val(Right(mNumberOfDigits(mCntr), 1))), "")
190           ElseIf Len(mNumberOfDigits(mCntr)) = 1 Then
200               Word = Word & " " & OneD(val(mNumberOfDigits(mCntr)))
210           End If
220           If Len(mInput) >= 4 And Len(mInput) <= 6 Then Word = Word & IIf(mCntr = 0 And mNumberOfDigits(0) > 0, " Thousand ", "")
230           If Len(mInput) >= 7 And Len(mInput) <= 9 Then Word = Word & IIf(mCntr = 0 And mNumberOfDigits(0) > 0, " Million ", IIf(mCntr = 1 And mNumberOfDigits(1) > 0, "Thousand ", ""))
240           If Len(mInput) >= 10 And Len(mInput) <= 12 Then Word = Word & IIf(mCntr = 0 And mNumberOfDigits(0) > 0, " Billion ", IIf(mCntr = 1 And mNumberOfDigits(1) > 0, "Million ", IIf(mCntr = 2 And mNumberOfDigits(2) > 0, "Thousand ", "")))
250       Next
          '==
          '-------------JED Oct 31 2016
260      ' Word = Word & IIf(val(mAmount) = 1, " Dollar ", " Dollars ")
         Word = Word & IIf(Mid(mAmount, 1, InStr(mAmount, ".") - 1) = 1, "Dollar ", "Dollars ")
270       If Right(mAmount, 2) > 0 Then
280           Word = Word & " and "
290       Else
300           Word = Word
310       End If

          '-------------JED Oct 31 2016
          '==
320       If mDec <> 0 Then
330           If val(mDecWhat) >= 1 And val(mDecWhat) <= 19 Then
340               Word = Word & OneD(val(mDecWhat)) & IIf(val(mDecWhat) = 1, " Cent", " Cents")
350           ElseIf val(mDecWhat) >= 2 Then
360               Word = Word & TwoD(val(Left(mDecWhat, 1))) & IIf(Right(mDecWhat, 1) >= 1, " " & OneD(val(Right(mDecWhat, 1))) & " Cents", " Cents")
370           End If
380       End If
390       If val(mAmount) > 0 Then
              'commented out part of line below to remove the presentation and P peso --- JED
400           Word = Word    '& " (P" & Format(mAmount, "##,##0.00") & ")": mInput = Format(mAmount, "##,##0.00")
410       End If
420       Convert = LTrim(Word): Word = ""

430       On Error GoTo 0
440       Exit Function

Convert_Error:

450       MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure Convert of Module ModuleTesting_CanKill"
End Function


Test routine
Code:
Sub TestInT()
    Dim nums(8) As Variant
    Dim i As Integer

10    nums(0) = 3.07
20    nums(1) = 3#
30    nums(2) = 1#
40    nums(3) = 1.01
50    nums(4) = 3004017.19
60    nums(5) = 3004017
70    nums(6) = 101
80    nums(7) = 101.88

90    For i = 0 To 7
100     Debug.Print Convert(nums(i))
110   Next i
End Sub

Results

Code:
Three Dollars  and Seven  Cents
Three Dollars 
One Dollar 
One Dollar  and One  Cent
Three  Million  Four Thousand  Seventeen Dollars  and Nineteen  Cents
Three  Million  Four Thousand  Seventeen Dollars 
One Hundred One Dollars 
One Hundred One Dollars  and Eighty  Eight  Cents

I'm not suggesting this is better or worse than the other function you had. It's just another function.
In my original post there was an error 1.01 gave One Dollars and One Cent
This is corrected in the code above.
 
Last edited:

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
Since there are 100 Kobos in 1 Naira, I altered the test routine

Code:
Sub TestInT()
    Dim nums(8) As Variant
    Dim i As Integer

10    nums(0) = 3.07
20    nums(1) = 3#
30    nums(2) = 1#
40    nums(3) = 1.01
50    nums(4) = 3004017.19
60    nums(5) = 3004017
70    nums(6) = 101
80    nums(7) = 101.88

90    For i = 0 To 7
100     Debug.Print Replace(Replace(Convert(nums(i)), "Dollar", "Naira"), "Cent", "Kobo")
110   Next i
End Sub

To give these results -which may make sense to you

Code:
Three Nairas  and Seven  Kobos
Three Nairas 
One Naira 
One Naira  and One  Kobo
Three  Million  Four Thousand  Seventeen Nairas  and Nineteen  Kobos
Three  Million  Four Thousand  Seventeen Nairas 
One Hundred One Nairas 
One Hundred One Nairas  and Eighty  Eight  Kobos

Good luck.


Nope:::: Still seeing some missing ands???
 
Last edited:

jdraw

Super Moderator
Staff member
Local time
Today, 13:45
Joined
Jan 23, 2006
Messages
15,393
Using the SpellNumber
found here https://support.microsoft.com/en-us/kb/213360
these are the results

Code:
Three Dollars and Seven Cents
Three Dollars and No Cents
One Dollar and No Cents
One Dollar and One Cent
Three Million Four Thousand Seventeen Dollars and Nineteen Cents
Three Million Four Thousand Seventeen Dollars and No Cents
One Hundred One Dollars and No Cents
One Hundred One Dollars and Eighty Eight Cents

using the test routine

Code:
Sub TestInT()
    Dim nums(8) As Variant
    Dim i As Integer

10    nums(0) = 3.07
20    nums(1) = 3#
30    nums(2) = 1#
40    nums(3) = 1.01
50    nums(4) = 3004017.19
60    nums(5) = 3004017
70    nums(6) = 101
80    nums(7) = 101.88

90    For i = 0 To 7
Debug.Print SpellNumber(nums(i))
100    [COLOR="SeaGreen"]' Debug.Print Replace(Replace(Convert(nums(i)), "Dollar", "Naira"), "Cent", "Kobo")[/COLOR]
110   Next i
End Sub
 

Users who are viewing this thread

Top Bottom