Be the first user to complete this post
|
Add to List |
VBA-Excel: Convert Numbers (Dollars, Euros) into Words or Text - Till Trillions
To Convert Numbers into Text, please follow the steps below
Download Link : NumberToWordsTrillion
Related Article:
Convert Numbers (Rupees) into Words OR Text - Updated Till 1000000 Crore
Example:
123456 | One Hundred Twenty Three Thousand Four Hundred Fifty Six |
1000000 | One Million |
1234567 | One Million Two Hundred Thirty Four Thousand Five Hundred Sixty Seven |
87654321 | Eighty Seven Million Six Hundred Fifty Four Thousand Three Hundred Twenty One |
456456 | Four Lac Fifty Six Thousand Four Hundred Fifty Six |
31311 | Thirty One Thousand Three Hundred Eleven |
235345 | Two Lac Thirty Five Thousand Three Hundred Fourty Five |
1234567 | Twelve Lacs Thirty Four Thousand Five Hundred Sixty Seven |
Steps:
- Download the NumberToWordsTrillion.xlsm
- Put the number in Column A
- Click the Create Button
- This step is not needed, because your job is already done :)
Complete Code:
Sub sumit() Dim mainWorkBook Set mainWorkBook = ActiveWorkbook intRows = mainWorkBook.Sheets("Main").UsedRange.Rows.Count 'MsgBox intRows For i = 1 To intRows intValue = mainWorkBook.Sheets("Main").Range("A" & i) If IsNumeric(intValue) And intValue <> "" Then mainWorkBook.Sheets("Main").Range("B" & i) = FnConvert(intValue) End If Next End Sub Function FnConvert(strNumber) strNumber = CStr(strNumber) If Len(strNumber) > 0 And Len(strNumber) < 2 Then strTextConversion = FnGetUnitDigit(strNumber) End If If Len(strNumber) > 1 And Len(strNumber) < 3 Then strTextConversion = FnGetTensDigit(strNumber) End If If Len(strNumber) > 2 And Len(strNumber) < 4 Then strTextConversion = FnGetHundreds(strNumber) End If If Len(strNumber) > 3 And Len(strNumber) < 6 Then If Len(strNumber) = 4 Then strTextConversion = FnGetThousandsOne(strNumber) End If If Len(strNumber) = 5 Then strTextConversion = FnGetThousandsTwo(strNumber) End If End If If Len(strNumber) > 5 And Len(strNumber) < 8 Then If Len(strNumber) = 6 Then strTextConversion = FnGetThousandsThree(strNumber) End If If Len(strNumber) = 7 Then strTextConversion = FnGetMillionOne(strNumber) End If End If If Len(strNumber) > 7 And Len(strNumber) < 15 Then If Len(strNumber) = 8 Then strTextConversion = FnGetMillionTwo(strNumber) End If If Len(strNumber) = 9 Then strTextConversion = FnGetMillionThree(strNumber) End If If Len(strNumber) = 10 Then strTextConversion = FnGetBillionOne(strNumber) End If If Len(strNumber) = 11 Then strTextConversion = FnGetBillionTwo(strNumber) End If If Len(strNumber) = 12 Then strTextConversion = FnGetBillionThree(strNumber) End If If Len(strNumber) = 13 Then strTextConversion = FnGetTrillionOne(strNumber) End If If Len(strNumber) = 14 Then 'strTextConversion = FnGetCroreSeven(strNumber) End If End If FnConvert = strTextConversion End Function Function FnGetTrillionOne(intN) Dim Str 'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1)) temp = FnGetUnitDigit(Left(intN, 1)) If temp <> "" Then Str = FnGetUnitDigit(Left(intN, 1)) & " Trillion " & FnGetBillionThree(Right(intN, Len(intN) - 1)) Else Str = FnGetBillionThree(Right(intN, Len(intN) - 1)) End If FnGetTrillionOne = Str End Function Function FnGetBillionThree(intN) Dim Str temp = FnGetHundreds(Left(intN, 3)) If temp <> "" Then Str = FnGetHundreds(Left(intN, 3)) & " Billion " & FnGetMillionThree(Right(intN, Len(intN) - 3)) Else Str = FnGetMillionThree(Right(intN, Len(intN) - 3)) End If FnGetBillionThree = Str End Function Function FnGetBillionTwo(intN) Dim Str temp = FnGetTensDigit(Left(intN, 2)) If temp <> "" Then Str = FnGetTensDigit(Left(intN, 2)) & " Million " & FnGetMillionThree(Right(intN, Len(intN) - 2)) Else Str = FnGetMillionThree(Right(intN, Len(intN) - 2)) End If FnGetBillionTwo = Str End Function Function FnGetBillionOne(intN) Dim Str 'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1)) temp = FnGetUnitDigit(Left(intN, 1)) If temp <> "" Then Str = FnGetUnitDigit(Left(intN, 1)) & " Billion " & FnGetMillionThree(Right(intN, Len(intN) - 1)) Else Str = FnGetMillionThree(Right(intN, Len(intN) - 1)) End If FnGetBillionOne = Str End Function Function FnGetMillionThree(intN) Dim Str temp = FnGetHundreds(Left(intN, 3)) If temp <> "" Then Str = FnGetHundreds(Left(intN, 3)) & " Million " & FnGetThousandsThree(Right(intN, Len(intN) - 3)) Else Str = FnGetThousandsThree(Right(intN, Len(intN) - 3)) End If FnGetMillionThree = Str End Function Function FnGetMillionTwo(intN) Dim Str 'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1)) temp = FnGetTensDigit(Left(intN, 2)) If temp <> "" Then Str = FnGetTensDigit(Left(intN, 2)) & " Million " & FnGetThousandsThree(Right(intN, Len(intN) - 2)) Else Str = FnGetThousandsThree(Right(intN, Len(intN) - 2)) End If FnGetMillionTwo = Str End Function Function FnGetMillionOne(intN) Dim Str 'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1)) temp = FnGetUnitDigit(Left(intN, 1)) If temp <> "" Then Str = FnGetUnitDigit(Left(intN, 1)) & " Million " & FnGetThousandsThree(Right(intN, Len(intN) - 1)) Else Str = FnGetThousandsThree(Right(intN, Len(intN) - 1)) End If FnGetMillionOne = Str End Function Function FnGetThousandsThree(intN) Dim Str temp = FnGetHundreds(Left(intN, 3)) If temp <> "" Then Str = FnGetHundreds(Left(intN, 3)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 3)) Else Str = FnGetHundreds(Right(intN, Len(intN) - 3)) End If FnGetThousandsThree = Str End Function Function FnGetThousandsTwo(intN) Dim Str 'Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2)) temp = FnGetTensDigit(Left(intN, 2)) If temp <> "" Then Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2)) Else Str = FnGetHundreds(Right(intN, Len(intN) - 2)) End If FnGetThousandsTwo = Str End Function Function FnGetThousandsOne(intN) Dim Str 'Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1)) temp = FnGetUnitDigit(Left(intN, 1)) If temp <> "" Then Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1)) Else Str = FnGetHundreds(Right(intN, Len(intN) - 1)) End If FnGetThousandsOne = Str End Function Function FnGetHundreds(intN) Dim Str temp = FnGetUnitDigit(Left(intN, 1)) If temp <> "" Then Str = FnGetUnitDigit(Left(intN, 1)) & " Hundred " & FnGetTensDigit(Right(intN, 2)) Else Str = FnGetTensDigit(Right(intN, 2)) End If FnGetHundreds = Trim(Str) End Function Function FnGetTensDigit(intN) Dim Str If Left(intN, 1) = 1 Then Select Case Val(intN) Case 10: Str = "Ten" Case 11: Str = "Eleven" Case 12: Str = "Twelve" Case 13: Str = "Thirteen" Case 14: Str = "Fourteen" Case 15: Str = "Fifteen" Case 16: Str = "Sixteen" Case 17: Str = "Seventeen" Case 18: Str = "Eighteen" Case 19: Str = "Nineteen" End Select Else Select Case Val(Left(intN, 1)) Case 2: Str = "Twenty" Case 3: Str = "Thirty" Case 4: Str = "Fourty" Case 5: Str = "Fifty" Case 6: Str = "Sixty" Case 7: Str = "Seventy" Case 8: Str = "Eighty" Case 9: Str = "Ninty" End Select Str = Str & " " & FnGetUnitDigit(Right(intN, 1)) End If FnGetTensDigit = Trim(Str) End Function Function FnGetUnitDigit(intN) Dim Str Select Case Val(intN) Case 1: Str = "One" Case 2: Str = "Two" Case 3: Str = "Three" Case 4: Str = "Four" Case 5: Str = "Five" Case 6: Str = "Six" Case 7: Str = "Seven" Case 8: Str = "Eight" Case 9: Str = "Nine" End Select FnGetUnitDigit = Trim(Str) End Function
Download Link : NumberToWordsTrillion
Also Read:
- VBA-Excel: Modified Consolidator – Merge or Combine Multiple Excel Files Into One Where Columns Are Not In Order
- VBA-Excel - Merger - Merge or Combine Many Word Documents Into One
- VBA-Excel — AttachmentFetcher — Download all the Attachments from All the Mails of Specific Subject in Microsoft Outlook .
- VBA-Excel: Convert Numbers (Rupees) into Words OR Text - Updated Till 1000000 Crore With Decimal Numbers