Help with Number To Words Code for Indian Currency

[prkhan56]

Hello All,
I have obtained this routine from the Net
Following are the results when run:

a) 1.10 -> Rupees One Thousand One and Ten Paisa only (wrong) Should
be
Rupees One and Ten Paisa only

b) 2.20 -> Rupees Two Thousand Two and Twenty Paisa only (wrong)
Should be
Rupees Two and Twenty Paisa only

c) 12.30 -> Rupees Twelve Thousand Twelve and Thirty Paisa only
(wrong) Should be
Rupees Twelve and Thirty Paisa only

d) 123.42 -> Rupees One Hundred Twenty Three and Forty Two Paisa only
(correct)

e) 1234.52 -> Rupees One Thousand Two Hundred Thirty Four and Fifty
Two Paisa only (correct)

f) 12345.00 Rupees Twelve Thousand Three Hundred Forty Five only
(wrong) not showing
Zero Paisa

g) 123456.00 -> Rupees One Lakh Twenty Three Thousand Four Hundred
Fifty Six only (wrong)
not showing Zero Paisa

Can anybody help me in correcting the routine to display correctly in
example a) b) and c) and display the zero as the case may be?

Thanks in advance

This is the routine:

Option Explicit

' Function for conversion of a Currency to words
' Parameter - accept a Currency
' Returns the number in words format
'*************************************************

Function Sam(ByVal MyNumber)
Dim Temp
Dim Rupees, Paisa As String
Dim DecimalPlace, iCount
Dim Hundred, Words As String
ReDim Place(9) As String
Place(0) = " Thousand "
Place(2) = " Lakh "
Place(4) = " Crore "
Place(6) = " Arab "
Place(8) = " Kharab "
On Error Resume Next
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")

' If we find decimal place...
If DecimalPlace > 0 Then
' Convert Paisa
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Paisa = " and " & ConvertTens(Temp) & " Paisa"

' Strip off paisa from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

' Convert last 3 digits of MyNumber to ruppees in word.
Hundred = ConvertHundred(Right(MyNumber, 3))
' Strip off last three digits
MyNumber = Left(MyNumber, Len(MyNumber) - 3)

iCount = 0
Do While MyNumber <> ""
'Strip last two digits
Temp = Right(MyNumber, 2)
If Len(MyNumber) = 1 Then
Words = ConvertDigit(Temp) & Place(iCount) & Words
MyNumber = Left(MyNumber, Len(MyNumber) - 1)

Else
Words = ConvertTens(Temp) & Place(iCount) & Words
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
End If
iCount = iCount + 2
Loop

Sam = "Rupees " & Words & Hundred & Paisa & " only"
End Function

' Conversion for Hundred
'*****************************************
Private Function ConvertHundred(ByVal MyNumber)
Dim Result As String

' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function

' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)

' Do we have a Hundred place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
End If

' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If

ConvertHundred = Trim(Result)
End Function

' Conversion for tens
'*****************************************
Private Function ConvertTens(ByVal MyTens)
Dim Result As String

' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
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
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 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

' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If

ConvertTens = Result
End Function

Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function

Rashid Khan

 

[Bob Phillips]

Could it be that your number format is interpreting the . as a thousands
separator, not the decimal point.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[merjet]

After: MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
Insert: Else
Paisa = " and Zero Paisa"

Replace:
MyNumber = Left(MyNumber, Len(MyNumber) - 3)

With:
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If

Hth,
Merjet

 

[prkhan56]

Hi Bob,
I have checked my Regional Settings and Format in Excel also.
Thousand separator is , (comma).
You will see that the Funtion does work properly for digits equal to
or greater than 3...the problem is only with single and double digit
figures.
Thanks for your time
Rashid Khan

 

[prkhan56]

Hello Merjet,
Your solution works fine.
Thanks to you for your assistance.
Also thanks to Bob for his time

Rashid Khan

 

[prkhan56]

Hello Merjet,
I just checked the funtion and it is not working properly for
thousands onwards and working for single and two digits
only....previously single and two digits were not working...now it is
other way round.
this is the complete routine now...May be I missed something...Can you
just see and test it your self please

This is the revised routine
Option Explicit

' Function for conversion of a Currency to words
' Parameter - accept a Currency
' Returns the number in words format
'*************************************************

Function Sam(ByVal MyNumber)
Dim Temp
Dim Rupees, Paisa As String
Dim DecimalPlace, iCount
Dim Hundred, Words As String
ReDim Place(9) As String
Place(0) = " Thousand "
Place(2) = " Lakh "
Place(4) = " Crore "
Place(6) = " Arab "
Place(8) = " Kharab "
On Error Resume Next
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))

' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")

' If we find decimal place...
If DecimalPlace > 0 Then
' Convert Paisa
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Paisa = " and " & ConvertTens(Temp) & " Paisa"

' Strip off paisa from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
'the following added for correction of Zero Paisa
Else
Paisa = " and Zero Paisa"
'the above added for correction of Zero Paisa
End If

' Convert last 3 digits of MyNumber to ruppees in word.
Hundred = ConvertHundred(Right(MyNumber, 3))
' Strip off last three digits
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
'the following added to correct the display of Unit and Ten Values
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
'the above added to correct the display of Unit and Ten Values
iCount = 0
Do While MyNumber <> ""
'Strip last two digits
Temp = Right(MyNumber, 2)
If Len(MyNumber) = 1 Then
Words = ConvertDigit(Temp) & Place(iCount) & Words
MyNumber = Left(MyNumber, Len(MyNumber) - 1)

Else
Words = ConvertTens(Temp) & Place(iCount) & Words
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
End If
iCount = iCount + 2
Loop

Sam = "Rupees " & Words & Hundred & Paisa & " only"
End Function

' Conversion for Hundred
'*****************************************
Private Function ConvertHundred(ByVal MyNumber)
Dim Result As String

' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function

' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)

' Do we have a Hundred place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
End If

' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If

ConvertHundred = Trim(Result)
End Function

' Conversion for tens
'*****************************************
Private Function ConvertTens(ByVal MyTens)
Dim Result As String

' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
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
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 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

' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If

ConvertTens = Result
End Function

Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function

 

[Bob Phillips]

Try my version

Option Explicit

'-----------------------------------------------------------­------
Function SpellNumber(ByVal MyNumber, _
Optional incRupees As Boolean = True)
'-----------------------------------------------------------­------
Dim Crores, Lakhs, Rupees, Paise, Temp
Dim DecimalPlace As Long, Count As Long
Dim myLakhs, myCrores

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 Paise and set MyNumber to Rupees amount.
If DecimalPlace > 0 Then
Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
myCrores = MyNumber \ 10000000
myLakhs = (MyNumber - myCrores * 10000000) \ 100000
MyNumber = MyNumber - myCrores * 10000000 - myLakhs * 100000

Count = 1
Do While myCrores <> ""
Temp = GetHundreds(Right(myCrores, 3))
If Temp <> "" Then Crores = Temp & Place(Count) & Crores
If Len(myCrores) > 3 Then
myCrores = Left(myCrores, Len(myCrores) - 3)
Else
myCrores = ""
End If
Count = Count + 1
Loop

Count = 1
Do While myLakhs <> ""
Temp = GetHundreds(Right(myLakhs, 3))
If Temp <> "" Then Lakhs = Temp & Place(Count) & Lakhs
If Len(myLakhs) > 3 Then
myLakhs = Left(myLakhs, Len(myLakhs) - 3)
Else
myLakhs = ""
End If
Count = Count + 1
Loop

Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Crores
Case "": Crores = ""
Case "One": Crores = " One Crore "
Case Else: Crores = Crores & " Crores "
End Select

Select Case Lakhs
Case "": Lakhs = ""
Case "One": Lakhs = " One Lakh "
Case Else: Lakhs = Lakhs & " Lakhs "
End Select

Select Case Rupees
Case "": Rupees = "Zero "
Case "One": Rupees = "One "
Case Else: Rupees = Rupees
End Select

Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and Paise " & Paise & " Only "
End Select

SpellNumber = IIf(incRupees, "Rupees ", "") & Crores & Lakhs & Rupees &
Paise

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

'-----------------------------------------------------------­------


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[prkhan56]

Hello Bob,
Thanks for the quick response.
Works great.

Rashid Khan

 

[Bob Phillips]

I was going to offer that right at the start, but then thought it must be
the number settings <G>

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



Hello Bob,
Thanks for the quick response.
Works great.

Rashid Khan

 

[merjet]

Rashid,

My fixes didn't work for you because you added rather than replaced. I
said to REPLACE MyNumber = Left(MyNumber, Len(MyNumber) - 3)
WITH: If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If

In other words, MyNumber = Left(MyNumber, Len(MyNumber) - 3)
should appear once, not twice.

Merjet