Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 31

Thread: Indian number format

  1. #1

    Indian number format

    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

  2. #2
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    How were you expecting negative numbers to be displayed? Please post an example of a formatted negative number.

  3. #3
    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

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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.
    Last edited by Aussiebear; 04-06-2023 at 03:09 AM. Reason: Adjusted the code tags

  5. #5
    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

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    I have tried with custom format many times, but have never been successful. Shame, but there it is.

  7. #7
    VBAX Regular
    Joined
    May 2007
    Posts
    36
    Location
    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

  8. #8
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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
    Last edited by Aussiebear; 04-06-2023 at 03:08 AM. Reason: Adjusted the code tags

  9. #9
    VBAX Regular
    Joined
    May 2007
    Posts
    36
    Location
    Code is working but it is appearing under any menu.Can this be done?

  10. #10
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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
    Last edited by Aussiebear; 04-06-2023 at 03:08 AM. Reason: Adjusted the code tags

  11. #11
    VBAX Regular
    Joined
    May 2007
    Posts
    36
    Location
    No menu is appearing under any main menu. Addin is attached. Plz look it

  12. #12
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    It only works if you put the code into the addin, it doesn't happen by magic.

  13. #13
    VBAX Regular
    Joined
    May 2007
    Posts
    36
    Location
    Very thnaks to xld for providing the solution and to sujittalukde for posting such a nice problem.

  14. #14
    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

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Problem is that it runs out of format options. You could replace the -, but then it is not a negative number anymore.

  16. #16
    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.

  17. #17
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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
    Last edited by Aussiebear; 04-06-2023 at 03:05 AM. Reason: Adjusted the code tags

  18. #18
    This has fixed the bug. The last code is now fully working as desired.Thanks again.

  19. #19
    VBAX Mentor anandbohra's Avatar
    Joined
    May 2007
    Location
    Mumbai
    Posts
    313
    Location

    indian currency format between 4-16 character long number

    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
    Last edited by Aussiebear; 04-06-2023 at 03:04 AM. Reason: Adjusted the code tags

  20. #20
    VBAX Mentor anandbohra's Avatar
    Joined
    May 2007
    Location
    Mumbai
    Posts
    313
    Location

    Indian rupees in words

    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
    Last edited by Aussiebear; 04-06-2023 at 02:57 AM. Reason: Adjusted the code tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •