Indian number format

[sujittalukde]

Bahut bahut dhanyawad,anandji, but negative number is not appearing in brackets?

[Bob Phillips]

Option Explicit
Dim iLoop ' For Lacs

'****************' Main Function *'****************
Public Function Anand_Indian_spell_number(ByVal MyNumber)
Dim Rupees, Paise, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Lacs " '
Place(4) = " Crores "
Place(5) = " Trillion "
MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none
' Expand the logic to 999 crores from 9 lacs
If (MyNumber > 999999999.99) Then
'If (MyNumber > 999999.99) Then
Anand_Indian_spell_number = "Digit excced Maximum limit"
Exit Function
End If
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
Count = 1
Dim iTemp As Integer
Do While MyNumber <> ""
If (Count >= 2) Then
iTemp = Right(MyNumber, 2)
Else
If (Len(MyNumber) = 2) Then
iTemp = Right(MyNumber, 2)
ElseIf (Len(MyNumber) = 1) Then
iTemp = Right(MyNumber, 1)
Else
iTemp = Right(MyNumber, 3)
End If
End If
If iTemp > 99 Then
iTemp = Right(MyNumber, 3)
Temp = GetHundreds(iTemp)
ElseIf iTemp < 99 And iTemp > 9 Then
iTemp = Right(MyNumber, 2)
Temp = GetTens(iTemp)
ElseIf iTemp < 10 Then
iTemp = Right(MyNumber, 2)
Temp = GetDigit(iTemp)
End If
'end if
If Temp <> "" Then
Rupees = Temp & Place(Count) & Rupees
End If
'If Len(MyNumber) > 3 Then
If Count = 2 Then
If Len(MyNumber) = 1 Then
MyNumber = ""
Else
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
End If
ElseIf Count = 3 Then
If Len(MyNumber) >= 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
Else
MyNumber = ""
End If
ElseIf Count = 4 Then
MyNumber = ""
Else
If Len(MyNumber) <= 2 Then
MyNumber = ""
Else
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
End If
End If
Count = Count + 1
Loop
Select Case Rupees
Case ""
Rupees = "No Rupees"
Case "One"
Rupees = "One Rupee"
Case Else
Rupees = " Rupees " & Rupees
End Select
Select Case Paise
Case ""
Paise = ""
Case "One"
Paise = " and One Paisa"
Case Else
Paise = " and " & Paise & " Paise"
End Select
Anand_Indian_spell_number = Rupees & Paise & " Only"
iLoop = 0
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
If (iLoop > 0) Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Lac "
iLoop = 0
Else
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
iLoop = iLoop + 1
End If
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

How nice, an answer to the question that no-one asked.

[geekgirlau]

Anand, when you post code, make sure you use the VBA tags - if you paste your code into the post, select it and then click on the "VBA" button, as this makes it easier to read.

[anandbohra]

OK sir
Next time i will keep this in mind

[aavvijit]

[vba]
Sub Indianrupees()
On Error GoTo Anand:

Dim rcell As Range
Dim rrupeerange As Range

Set rcell = ActiveCell
Set rrupeerange = Application.InputBox(prompt:="Select a cell or a Range ", Type:=8, _
Default:=Selection.Address)
areacount = rrupeerange.Cells.Count

If areacount < 65000 Then
Application.StatusBar = "Wait while System Converts into Indian Rupee Format....!"
Application.ScreenUpdating = False

For Each rcell In rrupeerange
Select Case rcell.Value
Case Is >= 1E+15
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 10000000000000#
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 100000000000#
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 1000000000
rcell.Cells.NumberFormat = "##"",""00"",""00"",""00"",""000.00"

Case Is >= 10000000
rcell.Cells.NumberFormat = "##"",""00"",""00"",""000.00"

Case Is >= 100000
rcell.Cells.NumberFormat = "##"",""00"",""000.00"

Case Else
rcell.Cells.NumberFormat = "##,###.00"
End Select
Next rcell

Application.ScreenUpdating = True
Set rcell = Nothing
Set rrupeerange = Nothing
Application.StatusBar = ""

Else

a = MsgBox("You had selected Total " & areacount & " Cells, Want to Proceed ? ", _
vbYesNo, "Anand M. Bohra")

If a = vbYes Then
Application.StatusBar = "Wait while System Converts into Indian Rupee Format....!"

Application.ScreenUpdating = False

For Each rcell In rrupeerange
Select Case rcell.Value
Case Is >= 1E+15
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 10000000000000#
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 100000000000#
rcell.Cells.NumberFormat = _
"##"",""00"",""00"",""00"",""00"",""000.00"

Case Is >= 1000000000
rcell.Cells.NumberFormat = "##"",""00"",""00"",""00"",""000.00"

Case Is >= 10000000
rcell.Cells.NumberFormat = "##"",""00"",""00"",""000.00"

Case Is >= 100000
rcell.Cells.NumberFormat = "##"",""00"",""000.00"

Case Else
rcell.Cells.NumberFormat = "##,###.00"
End Select
Next rcell

Application.ScreenUpdating = True
Set rcell = Nothing
Set rrupeerange = Nothing
Application.StatusBar = ""

Else
MsgBox "Select Smaller data for Faster Formatting", vbInformation, _
"Anand M. Bohra"
End If
End If

Exit Sub

Anand:
MsgBox "Oopss...........!", vbCritical, "Anand M. Bohra"
End Sub
[/vba]
Edited 4-Jun-07 by geekgirlau. Reason: insert vba tags

Dear Anand

You have written a excellent VBA

Only one query,

Is it possible to show in the same code negative numbers within bracket and in red colour.

If that can be done it will be excellent.

Please accept my thanks in advance

Regards,

[bkgashok]

you can also change the regional settings to this format...from the control panel

[DHAWAL]

Sir,
What if value is updated. For example If value is decreased from Lakhs to Thousand then it is showing ,00,000 we have to again run macro code..?

[Aussiebear]

@dhawal, This thread is 13 years old. Could you please start a new thread?

[DHAWAL]

if value is changed (decreased from crores to thousand) then it is showing value like this
,,00,000.
for example if value before running above code is 2,35,25,367 and it is changed to 25,367 it is showing value like this ,,25,367 instead of 25,367

is it possible to updated value formatting as and when it is changed.

[DHAWAL]

Sub Indianrupees()
On Error GoTo Anand:
Dim rcell As Range
Dim rrupeerange As Range
Set rcell = ActiveCell
Set rrupeerange = Application.InputBox(prompt:="Select a cell or a Range ", Type:=8, _
Default:=Selection.Address)
areacount = rrupeerange.Cells.Count
If areacount < 65000 Then
   Application.StatusBar = "Wait while System Converts into Indian Rupee Format....!"
   Application.ScreenUpdating = False
   For Each rcell In rrupeerange
      Select Case rcell.Value
         Case Is >= 1E+15
            rcell.Cells.NumberFormat = _
            "##"",""00"",""00"",""00"",""00"",""00"",""00"",""000.00"
         Case Is >= 10000000000000#
            rcell.Cells.NumberFormat = _
            "##"",""00"",""00"",""00"",""00"",""00"",""000.00"
         Case Is >= 100000000000#
            rcell.Cells.NumberFormat = _
            "##"",""00"",""00"",""00"",""00"",""000.00"
         Case Is >= 1000000000
            rcell.Cells.NumberFormat = "##"",""00"",""00"",""00"",""000.00"
         Case Is >= 10000000
            rcell.Cells.NumberFormat = "##"",""00"",""00"",""000.00"
         Case Is >= 100000
            rcell.Cells.NumberFormat = "##"",""00"",""000.00"
         Case Else
            rcell.Cells.NumberFormat = "##,###.00"
      End Select
   Next rcell
   Application.ScreenUpdating = True
   Set rcell = Nothing
   Set rrupeerange = Nothing
   Application.StatusBar = ""
   Else
   a = MsgBox("You had selected Total " & areacount & " Cells, Want to Proceed ? ", _
   vbYesNo, "Anand M. Bohra")
   If a = vbYes Then
      Application.StatusBar = "Wait while System Converts into Indian Rupee Format....!"
      Application.ScreenUpdating = False
      For Each rcell In rrupeerange
         Select Case rcell.Value
            Case Is >= 1E+15
               rcell.Cells.NumberFormat = _
               "##"",""00"",""00"",""00"",""00"",""00"",""00"",""000.00"
            Case Is >= 10000000000000#
               rcell.Cells.NumberFormat = _
               "##"",""00"",""00"",""00"",""00"",""00"",""000.00"
            Case Is >= 100000000000#
               rcell.Cells.NumberFormat = _
               "##"",""00"",""00"",""00"",""00"",""000.00"
            Case Is >= 1000000000
               rcell.Cells.NumberFormat = "##"",""00"",""00"",""00"",""000.00"
            Case Is >= 10000000
               rcell.Cells.NumberFormat = "##"",""00"",""00"",""000.00"
            Case Is >= 100000
               rcell.Cells.NumberFormat = "##"",""00"",""000.00"
            Case Else
               rcell.Cells.NumberFormat = "##,###.00"
         End Select
      Next rcell
      Application.ScreenUpdating = True
      Set rcell = Nothing
      Set rrupeerange = Nothing
      Application.StatusBar = ""
      Else
      MsgBox "Select Smaller data for Faster Formatting", vbInformation, "Anand M. Bohra"
   End If
End If
Exit Sub

if value is changed (decreased from crores to thousand) then it is showing value like this
,,00,000.
for example if value before running above code is 2,35,25,367 and it is changed to 25,367 it is showing value like this ,,25,367 instead of 25,367

is it possible to updated value formatting as and when it is changed.

[Aussiebear]

Dhwal, as I have previously indicated this thread is over 13 years old. Please start a new one?