# How to make this Proper way to Convert USD DOLLAR Amount to Word.....in EXCEL VBA Script ?????

[krunal123]

(Based Microsoft 2016/365 )



USD $ :


100050.20

ONE LAKH FIFTY AND CENTS TWENTY ONLY --( This line has been Proper way to convert USD Dollar to word)


( I Was used Powerutility add-ins but every time change Formula , Im scared, totaly time Wasting every time ..........


Show above the result.......

pleased make this VB module File...... & send us

 

[mehidy1437]

I'm using this for a long time.
I have put this in personal workbook & add the macro in the customized ribbon & using for any file.
This will show the result in the active cell.

Option Explicit
     
'Main Function
Function NumToWords(ByVal MyNumber)
   
    'Written by Philip Treacy
    'http://www.myonlinetraininghub.com/convert-numbers-currency-to-words-with-excel-vba
    'Feb 2014
    'Based on code from Microsoft http://support.microsoft.com/kb/213360
    'This code is not guaranteed to be error-free.  No warranty is implied or expressed. Use at your own risk and carry out your own testing
   
    Dim Units As String
    Dim SubUnits As String
    Dim TempStr As String
    Dim DecimalPlace As Integer
    Dim count As Integer
    Dim DecimalSeparator As String
    Dim UnitName As String
    Dim SubUnitName As String
    Dim SubUnitSingularName As String
   
    ' Change these as required **************************
    UnitName = "Dollar" ' NOTE : This is singular
    SubUnitName = "Cents"  ' NOTE : This is plural
    SubUnitSingularName = "Cent"  ' NOTE : This is singular
    DecimalSeparator = "."
    ' ***************************************************
   
   
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
           
    ' Convert MyNumber to STRING and TRIM white space
    MyNumber = Trim(CStr(MyNumber))
       
    'If MyNumber is blank then exit
    If MyNumber = "" Then
   
        NumToWords = ""
       
        Exit Function
   
    End If
       
    ' Find Position of decimal place, 0 if none.
    DecimalPlace = InStr(MyNumber, DecimalSeparator)
   
   
    ' Convert SubUnits and set MyNumber to Units amount.
    If DecimalPlace > 0 Then
   
        SubUnits = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
       
    End If
   
   
    count = 1
    Do While MyNumber <> ""
       
        TempStr = GetHundreds(Right(MyNumber, 3))
       
        If TempStr <> "" Then Units = TempStr & Place(count) & Units
       
        If Len(MyNumber) > 3 Then
       
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
           
        Else
           
            MyNumber = ""
           
        End If
       
        count = count + 1
       
    Loop
   
    Select Case Units
       
        Case ""
            Units = "No " & UnitName & "s"
       
        Case "One"
            Units = "One " & UnitName
       
        Case Else
            Units = Units & " " & UnitName & "s"
           
    End Select
   
    Select Case SubUnits
   
        Case ""
            SubUnits = " and No " & SubUnitName
   
        Case "One"
            SubUnits = " and One " & SubUnitSingularName

        Case Else
            SubUnits = " and " & SubUnits & " " & SubUnitName
           
    End Select
   
   
    NumToWords = Application.Trim(Units & SubUnits)
   
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

Sub FunctionNumToWords()

'vba run or not confirmation
Dim Msg As String, Ans As Variant

    Msg = "This will add NumToWords FUNCTION in the active cell, active cell should be blank"

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes
'vba run or not confirmation

    Dim Rng As Range
    Dim firstcolcell As String
    Dim selectioncell As String
    Dim InputAddress As String

   Set Rng = Application.InputBox("Range:", Type:=8)
   InputAddress = Rng.Cells.Address(0, 0)
    'Set Rng = Selection
       selectioncell = Rng.Address(0, 0)

        firstcolcell = ActiveCell.Address(0, 0)
        'lastcolcell = ActiveCell.Offset(0, 1).Address(0, 0)
       

             'LastRow22 = Rng.Rows.Count - 1
                'LastRow23 = Rng.Rows.Count
     'actvelastrow = ActiveCell.Offset(LastRow22, 0).Address(0, 0)
     'actveNextcolLastRow = ActiveCell.Offset(LastRow22, 1).Address(0, 0)
    'actveResultCell = ActiveCell.Offset(LastRow23, 1).Address
       If Rng.Cells.count <> 1 Then
     MsgBox "One cell needed -" & _
         vbLf & "please select One cells!"
      Exit Sub
   End If

    'Range(actveResultCell).Formula = "=SUMPRODUCT((" & firstcolcell & ":" & actvelastrow & ")*(" & lastcolcell & ":" & actveNextcolLastRow & "))"
    'Range(firstcolcell).Formula = "=NumToWords(" & InputAddress & ")"
    Range(firstcolcell).Formula = "=PERSONAL.XLSB!NumToWords(" & InputAddress & ")"
    Range(firstcolcell).Value = Range(firstcolcell).Value
    'cell.Value = UCase(cell.Value)
    'Range(firstcolcell).Value = UCase(Range(firstcolcell).Value)

'vba run or not confirmation

    Case vbNo
        GoTo Quit:
    End Select

Quit:
'vba run or not confirmation


End Sub

 

[krunal123]

Wow....So amazing 100% working ..........Thank You....so much

 

[mehidy1437]

You are welcome.

 

[Sulprobil]

I suggest to google for sbSpellNumber and to compare some inputs/results to the UDF NumToWords above:

sbSpellNumber.xlsm
	A	B	C
3	Number	Spell Number	NumToWords
4	1.000.000.000.000.000,00	>>>>> Error (Absolute amount > 999999999999999)! <<<<<	Hundred Fifteen Dollars and No Cents
5	0,123	Zero Dollars and Twelve Cents (rounded)	One Hundred Twenty Three Dollars and No Cents
6	-1,00	Minus One Dollar and Zero Cents	One Dollar and No Cents
7	20,123	Twenty Dollars and Twelve Cents (rounded)	Two Hundred Thousand One Hundred Twenty Three Dollars and No Cents
8	-20,123	Minus Twenty Dollars and Twelve Cents (rounded)	Two Hundred Thousand One Hundred Twenty Three Dollars and No Cents
9	1,01	One Dollar and One Cent	One Thousand Dollars and No Cents
10	1.000.001,01	One Million One Dollars and One Cent	One Billion One Thousand Dollars and No Cents
Sheet1

Cell Formulas
Range	Formula
B4:B10	B4	=sbspellnumber(A4)
C4:C10	C4	=NumToWords(A4)

The original Microsoft UDF had similar issues.

 

[mehidy1437]

I got two problems, but rest all are fine, also some format is much better to look in Numtowords.
Will look into these two problems in free time to sort out.

sbSpellNumber (1).xlsm
	A	B	C
1	Spell numbers:
2
3	Number	Spell Number	NumToWords
4	1,000,000,000,000,000.00	>>>>> Error (Absolute amount > 999999999999999)! <<<<<	Hundred Fifteen Dollars and No Cents
5	0.123	Zero Dollars and Twelve Cents (rounded)	No Dollars and Twelve Cents
6	-1.00	Minus One Dollar and Zero Cents	One Dollar and No Cents
7	20.123	Twenty Dollars and Twelve Cents (rounded)	Twenty Dollars and Twelve Cents
8	-20.123	Minus Twenty Dollars and Twelve Cents (rounded)	Hundred Twenty Dollars and Twelve Cents
9	1.01	One Dollar and One Cent	One Dollar and One Cent
10	1,000,001.01	One Million One Dollars and One Cent	One Million One Dollars and One Cent
11	101,999.19	Onehundredandone Thousand Ninehundredandninetynine Dollars and Nineteen Cents	One Hundred One Thousand Nine Hundred Ninety Nine Dollars and Nineteen Cents
12	102,999.99	Onehundredandtwo Thousand Ninehundredandninetynine Dollars and Ninetynine Cents	One Hundred Two Thousand Nine Hundred Ninety Nine Dollars and Ninety Nine Cents
13	111,999.88	Onehundredandeleven Thousand Ninehundredandninetynine Dollars and Eightyeight Cents	One Hundred Eleven Thousand Nine Hundred Ninety Nine Dollars and Eighty Eight Cents
14	121,999.33	Onehundredandtwentyone Thousand Ninehundredandninetynine Dollars and Thirtythree Cents	One Hundred Twenty One Thousand Nine Hundred Ninety Nine Dollars and Thirty Three Cents
15	119.00	Onehundredandnineteen Dollars and Zero Cents	One Hundred Nineteen Dollars and No Cents
16	100.00	Onehundred Dollars and Zero Cents	One Hundred Dollars and No Cents
17	99.00	Ninetynine Dollars and Zero Cents	Ninety Nine Dollars and No Cents
18	90.00	Ninety Dollars and Zero Cents	Ninety Dollars and No Cents
Sheet1

Cell Formulas
Range	Formula
B4:B18	B4	=sbspellnumber(A4)

 

[Sulprobil]

I am afraid you got more than two problems here:
With decimal separator "." and thousand separator "," you got
1. Upper and lower boundaries not correctly identified.
2. Negative numbers not identified.
3. Inaccurate numbers with fractions of Cents not identified (rounded).
With regards to decimal separator "," and thousand separator "." please see my post #5.

I suggest to argue about formats when the wording is right.
My program was used in a bank for printing of cheques. This does not provide any guarantee of correctness but at least it offers some comfort of extensive testing.

 

[JohnZ1156]

Try pasting this formula in the cell where you want the text to appear.
Change all of the E20 cell addresses to the cell address where you have your value.

=IF(AND(E8<1,E8<>0),"Zero Dollars and "&RIGHT(TEXT(E8,"000000000.00"),2)&" Cents",IF(E8=0,"",CHOOSE(LEFT(TEXT(E8,"000000000.00"))+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--LEFT(TEXT(E8,"000000000.00"))=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),2,1)=0,--MID(TEXT(E8,"000000000.00"),3,1)=0),"Hundred ","Hundred "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),2,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),2,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),3,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine "),
CHOOSE(MID(TEXT(E8,"000000000.00"),3,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))
&IF((--LEFT(TEXT(E8,"000000000.00"))+MID(TEXT(E8,"000000000.00"),2,1)+MID(TEXT(E8,"000000000.00"),3,1))=0,,IF(AND((--MID(TEXT(E8,"000000000.00"),4,1)+MID(TEXT(E8,"000000000.00"),5,1)+MID(TEXT(E8,"000000000.00"),6,1)+MID(TEXT(E8,"000000000.00"),7,1))=0,(--MID(TEXT(E8,"000000000.00"),8,1)+RIGHT(TEXT(E8,"000000000.00")))>0),"Million ","Million "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),4,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--MID(TEXT(E8,"000000000.00"),4,1)=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),5,1)=0,--MID(TEXT(E8,"000000000.00"),6,1)=0),"Hundred ","Hundred "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),5,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),5,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),6,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine "),CHOOSE(MID(TEXT(E8,"000000000.00"),6,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))
&IF((--MID(TEXT(E8,"000000000.00"),4,1)+MID(TEXT(E8,"000000000.00"),5,1)+MID(TEXT(E8,"000000000.00"),6,1))=0,,IF(OR((--MID(TEXT(E8,"000000000.00"),7,1)+MID(TEXT(E8,"000000000.00"),8,1)+MID(TEXT(E8,"000000000.00"),9,1))=0,--MID(TEXT(E8,"000000000.00"),7,1)<>0),"Thousand ","Thousand "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),7,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--MID(TEXT(E8,"000000000.00"),7,1)=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),8,1)=0,--MID(TEXT(E8,"000000000.00"),9,1)=0),"Hundred ","Hundred "))&
CHOOSE(MID(TEXT(E8,"000000000.00"),8,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),8,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),9,1)+1,"","One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")&"Dollars ",CHOOSE(MID(TEXT(E8,"000000000.00"),9,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))

&"and "&RIGHT(TEXT(E8,"000000000.00"),2)&" Cents"))

 

[krunal123]

Try pasting this formula in the cell where you want the text to appear.
Change all of the E20 cell addresses to the cell address where you have your value.

=IF(AND(E8<1,E8<>0),"Zero Dollars and "&RIGHT(TEXT(E8,"000000000.00"),2)&" Cents",IF(E8=0,"",CHOOSE(LEFT(TEXT(E8,"000000000.00"))+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--LEFT(TEXT(E8,"000000000.00"))=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),2,1)=0,--MID(TEXT(E8,"000000000.00"),3,1)=0),"Hundred ","Hundred "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),2,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),2,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),3,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine "),
CHOOSE(MID(TEXT(E8,"000000000.00"),3,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))
&IF((--LEFT(TEXT(E8,"000000000.00"))+MID(TEXT(E8,"000000000.00"),2,1)+MID(TEXT(E8,"000000000.00"),3,1))=0,,IF(AND((--MID(TEXT(E8,"000000000.00"),4,1)+MID(TEXT(E8,"000000000.00"),5,1)+MID(TEXT(E8,"000000000.00"),6,1)+MID(TEXT(E8,"000000000.00"),7,1))=0,(--MID(TEXT(E8,"000000000.00"),8,1)+RIGHT(TEXT(E8,"000000000.00")))>0),"Million ","Million "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),4,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--MID(TEXT(E8,"000000000.00"),4,1)=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),5,1)=0,--MID(TEXT(E8,"000000000.00"),6,1)=0),"Hundred ","Hundred "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),5,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),5,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),6,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine "),CHOOSE(MID(TEXT(E8,"000000000.00"),6,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))
&IF((--MID(TEXT(E8,"000000000.00"),4,1)+MID(TEXT(E8,"000000000.00"),5,1)+MID(TEXT(E8,"000000000.00"),6,1))=0,,IF(OR((--MID(TEXT(E8,"000000000.00"),7,1)+MID(TEXT(E8,"000000000.00"),8,1)+MID(TEXT(E8,"000000000.00"),9,1))=0,--MID(TEXT(E8,"000000000.00"),7,1)<>0),"Thousand ","Thousand "))
&CHOOSE(MID(TEXT(E8,"000000000.00"),7,1)+1,,"One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")
&IF(--MID(TEXT(E8,"000000000.00"),7,1)=0,,IF(AND(--MID(TEXT(E8,"000000000.00"),8,1)=0,--MID(TEXT(E8,"000000000.00"),9,1)=0),"Hundred ","Hundred "))&
CHOOSE(MID(TEXT(E8,"000000000.00"),8,1)+1,,,"Twenty ","Thirty ","Forty ","Fifty ","Sixty ","Seventy ","Eighty ","Ninety ")
&IF(--MID(TEXT(E8,"000000000.00"),8,1)<>1,CHOOSE(MID(TEXT(E8,"000000000.00"),9,1)+1,"","One ","Two ","Three ","Four ","Five ","Six ","Seven ","Eight ","Nine ")&"Dollars ",CHOOSE(MID(TEXT(E8,"000000000.00"),9,1)+1,"Ten ","Eleven ","Twelve ","Thirteen ","Fourteen ","Fifteen ","Sixteen ","Seventeen ","Eighteen ","Nineteen "))

&"and "&RIGHT(TEXT(E8,"000000000.00"),2)&" Cents"))

WE NEED THIS RESULT PLEASED SOLVE QUERY :