Search: | |||||

| ||||

Home » Forum » MS Office | RSS Feeds |

In India we use the following format to display currency:

1,00,000 -- Known as One Lakh instead of One Hundred Thousand

10,00,000 -- Known as Ten Lakhs instead of One Million.

10,000,000 --Known as One Crore instead of One Billion

I have used the following code and need help to display the value as shown

above.

Any help, suggestions or another code to suit my requirement would be

greatly appreciated

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

Replace your main function with this one:

Function SpellNumberLak(ByVal MyNumber)

Dim Dollars, Cents, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Lak "

Place(4) = " Crore "

' 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

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 = 2

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 2))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 2 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 2)

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

SpellNumberLak = Dollars & Cents

End Function

Note that this only works up to 99 Crore. You don't say what happens

above this.

how to run this code. i have copied this in the vba

module, but doesnt work.

What doesn't work?????????????????

Take a look at this file:

convert_numeral to text_cheque.xls

You should send the file to one of the moderators. Uploading is not

allowed by members because of malware...

How does it not work? Do you get an error? Do you get the wrong

results?

We're glad to help you out, but we need more information than "it

doesn't work".

Didn't find what you were looking for?
Find more on Convert figures to Words in Indian Format
Or get search suggestion and latest updates.

Related Topics:

- problem of converting a number into words using double
- converting numbers into words using double
- Converting numbers to words
- How to convert data to MS Money format
- generic conversion utility which can convert the resultset in the Hierarchical XML format
- can u figure out the error plz
- cannot resolve symbol symbol : constructor Figure ()
- Just figured it out
- why I can't figure it out..
- creating a figure using nested loops
- seeking the word or integer word
- Add-Ins loaded into Excel
- Script to start Ms Word and merge mail data from active spreadsheet
- Discover number format
- formatting text which is in text formula
- Saving a file xls as a txt format
- Chart formatting questions
- Exporting multiple sheets to .txt format
- RTF to Excel format
- Can't get an excel file with webpage formatting open in access
- Problem with date formats and searching
- Searching Excel from Word
- Cannot use the VBA add table command of MS word in MS Excel VBA
- Problem with Word object libraries
- 'Recognise' a specific numerical format and act accordingly