Be the first user to complete this post

  • 0
 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:

123456One Hundred Twenty Three Thousand Four Hundred Fifty Six
1000000One Million
1234567One Million Two Hundred Thirty Four Thousand Five Hundred Sixty Seven
87654321Eighty Seven Million Six Hundred Fifty Four Thousand Three Hundred Twenty One
456456Four Lac Fifty Six Thousand Four Hundred Fifty Six
31311Thirty One Thousand Three Hundred Eleven
235345Two Lac Thirty Five Thousand Three Hundred Fourty Five
1234567Twelve 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
Convert Numbers (Dollars, Euros) into Words or Text
Convert Numbers (Dollars, Euros) into Words or Text

Download Link : NumberToWordsTrillion

Also Read:

  1. VBA-Excel: Create worksheets with Names in Specific Format/Pattern.
  2. VBA-Excel: Consolidator – Merge or Combine Multiple Excel Files Into One
  3. VBA-Excel: Add Worksheets For All The Given Dates Except Weekends and Copy The Common Template In Each Worksheet
  4. VBA-Excel - Merger - Merge or Combine Many Word Documents Into One
  5. VBA-Excel — AttachmentFetcher — Download all the Attachments from All the Mails of Specific Subject in Microsoft Outlook .