Solved Convert amount to words (1 Viewer)

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
I have a database which am trying to convert amount to words.

I manage to obtain these codes which I modified to suite my needs.

My only issue is, the words doesn’t appear the way I want it.

The current codes, for example, it converts 705.50ghc as “seven hundred five cedis and fifty pesewas”

I will like the code modified so it can be read as “Seven hundred and five cedis, fifty pesewas”

Posted in access forums but couldn’t find the help I need. Will be glad if someone could assist me here.

Below is my code for analysis.
Public Function wsiSpellNumber(ByVal MyNumber) Dim Cedis, Pesewas, 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 pesewas and set MyNumber to cedis amount.
If DecimalPlace > 0 Then
Pesewas = 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 Cedis = Temp & Place(Count) & Cedis
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Cedis
Case ""
Cedis = ""
Case "One"
Cedis = "One Cedi"
Case Else
Cedis = Cedis & " Cedis"
End Select
Select Case Pesewas
Case ""
Pesewas = ""
Case "One"
Pesewas = " and One Pesewa"
Case Else
Pesewas = " and " & Pesewas & " Pesewas"
End Select
wsiSpellNumber = Cedis & Pesewas
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
 

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
@Gasman
If you read my description well, I stated that I have already posted in access forums and didn’t get the solution I needed. That is why I am re-posting here
 

Gasman

Enthusiastic Amateur
Local time
Today, 05:30
Joined
Sep 21, 2011
Messages
14,064
Yes you did, but no link to your post. Why make hard work for people who you want to help you? :(
 

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
Didn’t know I had to add the link to it.
Sorry about that
Will add the link next time
 

Gasman

Enthusiastic Amateur
Local time
Today, 05:30
Joined
Sep 21, 2011
Messages
14,064
Think about it. Members here would want to see what has already been offered? :( , so as not to repeat the same. Eg @anelgp might offer his code, which I had already supplied to you in the other forum?
 

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
Think about it. Members here would want to see what has already been offered? :( , so as not to repeat the same. Eg @anelgp might offer his code, which I had already supplied to you in the other forum?
Noted
 

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
No suggestions has actually been given from access forums per the request I posted here.

my codes works fine
Is just the arrangements that am finding issues
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:30
Joined
Oct 29, 2018
Messages
21,364
No suggestions has actually been given from access forums per the request I posted here.

my codes works fine
Is just the arrangements that am finding issues
Not thoroughly tested but give it a shot.
Code:
Public Function wsiSpellNumber(ByVal MyNumber) As String
'modified by thedbguy@gmail.com
'7/15/2022

Dim Cedis, Pesewas, 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 pesewas and set MyNumber to cedis amount.
If DecimalPlace > 0 Then
Pesewas = 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 Cedis = Temp & Place(Count) & Cedis
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Cedis
Case ""
Cedis = ""
Case "One"
Cedis = "One Cedi"
Case Else
Cedis = Cedis & " Cedis"
End Select
Select Case Pesewas
Case ""
Pesewas = ""
Case "One"
Pesewas = ", One Pesewa"
Case Else
Pesewas = ", " & Pesewas & " Pesewas"
End Select

'thedbguy
If Left(Cedis, 3) = "and" Then Cedis = Mid(Cedis, 5)

wsiSpellNumber = Cedis & Pesewas
End Function
 
Last edited:

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
Not thoroughly tested but give it a shot.
Code:
Public Function wsiSpellNumber(ByVal MyNumber) As String
'modified by thedbguy@gmail.com
'7/15/2022

Dim Cedis, Pesewas, 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 pesewas and set MyNumber to cedis amount.
If DecimalPlace > 0 Then
Pesewas = 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 Cedis = Temp & Place(Count) & Cedis
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Cedis
Case ""
Cedis = ""
Case "One"
Cedis = "One Cedi"
Case Else
Cedis = Cedis & " Cedis"
End Select
Select Case Pesewas
Case ""
Pesewas = ""
Case "One"
Pesewas = ", One Pesewa"
Case Else
Pesewas = ", " & Pesewas & " Pesewas"
End Select

'thedbguy
If Left(Cedis, 3) = "and" Then Cedis = Mid(Cedis, 5)

wsiSpellNumber = Cedis & Pesewas
End Function
I noticed the code doesn’t compile. I think there are errors in the code
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:30
Joined
Oct 29, 2018
Messages
21,364
I noticed the code doesn’t compile. I think there are errors in the code
Not in front of a computer now. I didn't try to compile it earlier, but the function ran for me and gave me the expected result. Does it not even run for you?
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 01:30
Joined
May 21, 2018
Messages
8,463
Code:
Public Sub Test()
  Dim i As Integer
  Dim n As Double
 For i = 1 To 10
    n = (1.23456789 * (10 ^ i))
    n = Round(n, 2)
    Debug.Print Format(n, "Standard") & " " & wsiSpellNumber(n)
  Next i
End Sub
results
Code:
12.35 Twelve Cedis, Thirty Five Pesewas
123.46 One Hundred Twenty Three Cedis, Forty Six Pesewas
1,234.57 One Thousand Two Hundred Thirty Four Cedis, Fifty Seven Pesewas
12,345.68 Twelve Thousand Three Hundred Forty Five Cedis, Sixty Eight Pesewas
123,456.79 One Hundred Twenty Three Thousand Four Hundred Fifty Six Cedis, Seventy Nine Pesewas
1,234,567.89 One Million Two Hundred Thirty Four Thousand Five Hundred Sixty Seven Cedis, Eighty Nine Pesewas
12,345,678.90 Twelve Million Three Hundred Forty Five Thousand Six Hundred Seventy Eight Cedis, Ninety  Pesewas
123,456,789.00 One Hundred Twenty Three Million Four Hundred Fifty Six Thousand Seven Hundred Eighty Nine Cedis
1,234,567,890.00 One Billion Two Hundred Thirty Four Million Five Hundred Sixty Seven Thousand Eight Hundred Ninety  Cedis
12,345,678,900.00 Twelve Billion Three Hundred Forty Five Million Six Hundred Seventy Eight Thousand Nine Hundred  Cedis
(y)
 
Last edited:

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
Not in front of a computer now. I didn't try to compile it earlier, but the function ran for me and gave me the expected result. Does it not even run for you?
It didn’t run
It gives an error when I tried to run it. That was why I tried to compile and it didn’t work
 

CJ_London

Super Moderator
Staff member
Local time
Today, 05:30
Joined
Feb 19, 2013
Messages
16,555
So what line gives the error when you compile and what is the error number and description?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:30
Joined
May 7, 2009
Messages
19,177
here is a New function for you:
Code:
'arnelgp
Public Function SpellTheNumber(ByVal num As Double, ByVal Denom As String, ByVal Fract As String, Optional ByVal properCase As Boolean = False) As String
Dim i As Integer, sFrac As String
Dim sNum As String
sNum = CStr(num)
i = InStrRev(sNum, ".")
If i <> 0 Then
    sFrac = Mid$(sNum, i)
    'remove the fraction part
    sNum = Replace$(sNum, sFrac, "")
    sFrac = Right$(sFrac, Len(sFrac) - 1)
    If Len(sFrac) > 2 Then
        sFrac = Left$(sFrac, 2)
    End If
End If
sNum = NumberToString(Val(sNum)) & " " & Denom
'remove the ","
sNum = Replace$(sNum, ",", "")
If Len(sFrac) <> 0 Then
    sNum = sNum & ", " & NumberToString(sFrac) & " " & Fract
Else
End If
If properCase Then
    sNum = StrConv(sNum, vbProperCase)
End If
SpellTheNumber = sNum
End Function


'http://vb-helper.com/howto_number_to_words3.html

' Return a word representation of the whole number value.
Public Function NumberToString(ByVal num_str As String, _
    Optional ByVal use_us_group_names As Boolean = True) As _
    String
Const CURRENCY_CHAR As String = "$"
Const SEPARATOR As String = ","
Const DECIMAL_POINT As String = "."

Dim groups() As String
Dim pos As Integer
Dim num_groups As Integer
Dim result As String
Dim group_num As Integer
Dim group_str As String
Dim group_value As Integer

    ' Get the appropiate group names.
    If use_us_group_names Then
        groups = Split(",thousand,million,billion," & _
            "trillion,quadrillion,quintillion," & _
            "sextillion,septillion,octillion," & _
            "nonillion,decillion,undecillion," & _
            "duodecillion,tredecillion," & _
            "quattuordecillion,quindecillion," & _
            "sexdecillion,septendecillion," & _
            "octodecillion,novemdecillion," & _
            "vigintillion", ",")
    Else
        groups = Split(",thousand,million," & _
            "milliard,billion,1000 billion," & _
            "trillion,1000 trillion,quadrillion," & _
            "1000 quadrillion,quintillion," & _
            "1000 quintillion,sextillion," & _
            "1000 sextillion,septillion," & _
            "1000 septillion,octillion," & _
            "1000 octillion,nonillion," & _
            "1000 nonillion,decillion," & _
            "1000 decillion", ",")
    End If

    ' Clean the string a bit.
    ' Remove "$", ",", leading zeros, and
    ' anything after a decimal point.
    num_str = Replace$(num_str, CURRENCY_CHAR, "")
    num_str = Replace$(num_str, SEPARATOR, "")
    Do While Left$(num_str, 1) = "0"
        num_str = Mid$(num_str, 2)
    Loop
    pos = InStr(num_str, DECIMAL_POINT)
    If pos = 1 Then
        NumberToString = "zero"
        Exit Function
    ElseIf pos > 1 Then
        num_str = Left$(num_str, pos - 1)
    End If

    ' See how many groups there will be.
    num_groups = (Len(num_str) + 2) \ 3

    ' Pad so length is a multiple of 3.
    num_str = Space$(num_groups * 3 - Len(num_str)) & _
        num_str

    ' Process the groups, largest first.
    result = ""
    For group_num = num_groups - 1 To 0 Step -1
        ' Get the next three digits.
        group_str = Mid$(num_str, 1, 3)
        num_str = Mid$(num_str, 4)
        group_value = CInt(group_str)

        ' Convert the group into words.
        If group_value > 0 Then
            If group_num >= UBound(groups) Then
                result = result & GroupToWords(group_value) _
                    & _
                    " ?, "
            Else
                result = result & GroupToWords(group_value) _
                    & _
                    " " & groups(group_num) & ", "
            End If
        End If
    Next group_num

    ' Remove the trailing ", ".
    If Right$(result, 2) = ", " Then
        result = Left$(result, Len(result) - 2)
    ElseIf Len(result) = 0 Then
        result = "zero"
    End If

    NumberToString = Trim$(result)
End Function

' Convert a number between 0 and 999 into words.
Private Function GroupToWords(ByVal num As Integer) As _
    String
Static done_before As Boolean
Static one_to_nineteen() As String
Static multiples_of_ten() As String

Dim digit As Integer
Dim result As String

    If Not done_before Then
        done_before = True
        one_to_nineteen = Split("zero,one,two,three," & _
            "four,five,six,seven,eight,nine,ten," & _
            "eleven,twelve,thirteen,fourteen,fifteen," & _
            "sixteen,seventeen,eightteen,nineteen", ",")
        multiples_of_ten = Split("twenty,thirty," & _
            "forty,fifty,sixty,seventy,eighty,ninety", ",")
    End If

    ' If the number is 0, return an empty string.
    GroupToWords = 0
    If num = 0 Then Exit Function

    ' Handle the hundreds digit.
    result = ""
    If num > 99 Then
        digit = num \ 100
        num = num Mod 100
        result = one_to_nineteen(digit) & " hundred"
    End If

    ' If num = 0, we have hundreds only.
    If num = 0 Then
        GroupToWords = Trim$(result)
        Exit Function
    End If

    ' See if the rest is less than 20.
    If num < 20 Then
        ' Look up the correct name.
        result = result & " " & one_to_nineteen(num)
    Else
        ' Handle the tens digit.
        digit = num \ 10
        num = num Mod 10
        result = result & " " & multiples_of_ten(digit - 2)

        ' Handle the final digit.
        If num > 0 Then
            result = result & " " & one_to_nineteen(num)
        End If
    End If

    GroupToWords = Trim$(result)
End Function

to use:

?SpellTheNumber(705.50, "cedis", "pasewas")

Result:

seven hundred five cedis, five pasewas
 

CJ_London

Super Moderator
Staff member
Local time
Today, 05:30
Joined
Feb 19, 2013
Messages
16,555
on the other thread, the OP wanted

seven hundred and five cedis, five pasewas

Also, not sure you have it quite right

?SpellTheNumber(705.50, "cedis", "pasewas")
seven hundred five cedis, five pasewas

?SpellTheNumber(705.51, "cedis", "pasewas")
seven hundred five cedis, fifty one pasewas
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:30
Joined
Oct 29, 2018
Messages
21,364
It didn’t run
It gives an error when I tried to run it. That was why I tried to compile and it didn’t work
Okay, back in front of a computer now. Please try the attached. Thank you.

1657980585125.png
 

Attachments

  • DBGuy.zip
    25 KB · Views: 111

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:30
Joined
May 7, 2009
Messages
19,177
Also, not sure you have it quite right
now this is right:
Code:
'arnelgp
Public Function SpellTheNumber(ByVal num As Double, ByVal Denom As String, ByVal Fract As String, Optional ByVal properCase As Boolean = False) As String
Dim i As Integer, sFrac As String
Dim sNum As String
sNum = CStr(num)
i = InStrRev(sNum, ".")
If i <> 0 Then
    sFrac = Mid$(sNum, i)
    'remove the fraction part
    sNum = Replace$(sNum, sFrac, "")
    sFrac = Right$(sFrac, Len(sFrac) - 1)
    If Len(sFrac) > 2 Then
        sFrac = Left$(sFrac, 2)
    End If
End If
sNum = NumberToString(Val(sNum)) & " " & Denom
'remove the ","
sNum = Replace$(sNum, ",", "")
If Len(sFrac) <> 0 Then
    If Len(sFrac) < 2 Then
        sFrac = sFrac & "0"
    End If
    sNum = sNum & ", " & NumberToString(sFrac) & " " & Fract
Else
End If
If properCase Then
    sNum = StrConv(sNum, vbProperCase)
End If
SpellTheNumber = sNum
End Function
 

Attachments

  • NumberToWord.accdb
    420 KB · Views: 127

Tiprof

Member
Local time
Today, 05:30
Joined
Apr 29, 2022
Messages
43
I will like to thank you for your wonderful support. You guys are amazing. Have been able to get it work the way i wanted it.
 

Users who are viewing this thread

Top Bottom