PDA

View Full Version : [SOLVED] Indian number format



sujittalukde
05-21-2007, 09:36 PM
Below is the custom number format for Indian number format
[>=10000000]#\,##\,##\,##0;[>=100000]##\,##\,##0;##,##0
This works well for positive numbers but does not work for negative numbers.Seniors may please modify the format so that the same can be equally useful for negative numbers

geekgirlau
05-21-2007, 11:29 PM
How were you expecting negative numbers to be displayed? Please post an example of a formatted negative number.

sujittalukde
05-22-2007, 01:33 AM
Suppose Cell A1 is formatted with above number format
If I write 1000000 in A1 it will display 10,00,000 ie Ten lacs (& not 1,000,000 ie One million)
But if I write -1000000 in A1 it will display -1,000,000 & not -10,00,000

Bob Phillips
05-22-2007, 02:24 AM
This is the problem with that custom number format, when you try to extend it to negative numbers it runs out of capability.

You need VBA in this case

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H10" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If IsNumeric(.Value) Then
If .Value > 0 Then
.NumberFormat = "[>=10000000]#\,##\,##\,##0;[>=100000]##\,##\,##0;##,##0"
ElseIf .Value < 0 Then
.NumberFormat = "[<=-10000000]-#\,##\,##\,##0;[<=-100000]-##\,##\,##0;##,##0"
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub


'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.

sujittalukde
05-22-2007, 04:00 AM
Many Many thanks. The code is working fully. I was trying to solve the same through number format method but did not succeed. Thanks for the code

Bob Phillips
05-22-2007, 04:03 AM
I have tried with custom format many times, but have never been successful. Shame, but there it is.

alok2007
05-22-2007, 10:02 PM
I was aso searching a similar number format for many days but now it has resolved my problem too. But since it is a maro code it creates a problem as the code must be attached with files. So I want to make it as an Add in & when installed it will display in a menu say Format.Please assign a short cut key stroke to it also.Also pls tell how to display the negative numbers in brackets.As the range is specified in the code itself making an addin will need some modification as column range will differ for files. So can this procedure be done that whenever the menu will be clicked,an input box will appear which will ask for column range?
Many many thanks

Bob Phillips
05-23-2007, 01:10 AM
What I would do is to add a toolbar button that formats the selected range in that style.


Public Sub IndianNumberStyle()
Dim cell As Range
Dim mPRev
For Each cell In Selection
If cell.Value > 0 Then
cell.NumberFormat = "[>=10000000]#\,##\,##\,##0;[>=100000]##\,##\,##0;##,##0"
ElseIf cell.Value < 0 Then
cell.NumberFormat = "[<=-10000000](#\,##\,##\,##0);[<=-100000](##\,##\,##0);(##,##0)"
End If
Next cell
End Sub

alok2007
05-23-2007, 02:17 AM
Code is working but it is appearing under any menu.Can this be done?

Bob Phillips
05-23-2007, 02:29 AM
Put this in your addin

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application.CommandBars("Formatting")
On Error Resume Next
.Controls("Indian").Delete
On Error GoTo 0
End With
End Sub

Private Sub Workbook_Open()
With Application.CommandBars("Formatting")
On Error Resume Next
.Controls("Indian").Delete
On Error GoTo 0
With .Controls.Add(Type:=msoControlButton, temporary:=True)
.BeginGroup = True
.Caption = "Indian"
.FaceId = 645
.Style = msoButtonIcon
.OnAction = "IndianNumberStyle"
End With
End With
End Sub

This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

alok2007
05-23-2007, 05:12 AM
No menu is appearing under any main menu. Addin is attached. Plz look it

Bob Phillips
05-23-2007, 06:20 AM
It only works if you put the code into the addin, it doesn't happen by magic.

alok2007
05-23-2007, 10:02 PM
Very thnaks to xld for providing the solution and to sujittalukde for posting such a nice problem.

sujittalukde
05-24-2007, 12:31 AM
One bug found
If u enter a number upto -99999 ie less than 6 digits negative number and then run the code it is displayed as –(99,999) & not (99,999).
Plz fix it

Bob Phillips
05-24-2007, 01:25 AM
Problem is that it runs out of format options. You could replace the -, but then it is not a negative number anymore.

sujittalukde
05-29-2007, 12:05 AM
Can the code be modified in a manner where upto -99,999 the number format will be normal excel format (i.e (99,999))and for a number more than -99,999 will be in Indian above mentioned format? (i.e say for -100000 will be (1,00,000)) & so on.
It will be very very useful.

Bob Phillips
05-29-2007, 12:53 AM
Public Sub IndianNumberStyle()
Dim cell As Range
Dim mFormat As String
For Each cell In Selection
If cell.Value > 0 Then
mFormat = "[>=10000000]#\,##\,##\,##0;[>=100000]##\,##\,##0;##,##0"
ElseIf cell.Value < 0 Then
If cell.Value >= -99999 Then
mFormat = "(#,##0);(#,##0)"
Else
mFormat = "[<=-10000000](#\,##\,##\,##0);[<=-100000](##\,##\,##0);(##,##0)"
End If
End If
cell.NumberFormat = mFormat
Next cell
End Sub

sujittalukde
05-29-2007, 02:54 AM
This has fixed the bug. The last code is now fully working as desired.Thanks again.

anandbohra
06-01-2007, 05:15 AM
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


Edited 4-Jun-07 by geekgirlau. Reason: insert vba tags

anandbohra
06-01-2007, 05:17 AM
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


Edited 4-Jun-07 by geekgirlau. Reason: insert vba tags

sujittalukde
06-01-2007, 05:53 AM
Bahut bahut dhanyawad,anandji, but negative number is not appearing in brackets?

Bob Phillips
06-01-2007, 05:56 AM
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
06-03-2007, 09:44 PM
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
06-03-2007, 10:51 PM
OK sir
Next time i will keep this in mind

aavvijit
09-04-2010, 04:54 AM
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

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
09-04-2010, 09:22 AM
you can also change the regional settings to this format...from the control panel

DHAWAL
04-06-2023, 02:37 AM
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
04-06-2023, 02:55 AM
@dhawal, This thread is 13 years old. Could you please start a new thread?

DHAWAL
04-07-2023, 04:36 AM
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
04-07-2023, 04:37 AM
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
04-07-2023, 01:01 PM
Dhwal, as I have previously indicated this thread is over 13 years old. Please start a new one?