Loading
Word.Tips.Net WordTips (Menu Interface)

Numbers to Words

There are times when it is beneficial, or even mandatory, to spell numbers out. For instance, you may want to spell out "1234" as "one thousand two hundred thirty four." You can do this using some of the field capabilities of Word, but some people don't like to use fields within their documents. The following VBA macro, NumberToWords, works quickly and easily to change numbers to words. It is rather long, but it has to do a lot of checking to put together the proper string. It will convert any number between 0 and 999,999. To use it, simply place the insertion point immediately to the right of the number you want to convert. If you place the insertion point in the middle of a number, you will not get the desired results. If you try to convert a number that is too large, or try to run the macro when there is text to the left of the insertion point, then you will get an error.

Sub NumberToWords()
Dim Number As Long
Dim Words As String
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
If IsNumeric(Selection) Then
    Number = CInt(Selection)
    Select Case Number
    Case 0
        Words = "Zero"
    Case 1 To 999999
        Words = SetThousands(Number)
    Case Else
        MsgBox "Number too large!", vbExclamation, "NumberToWords Macro"
    End Select
Else
    MsgBox "No number to left of insertion point!", _
    vbExclamation, "NumberToWords Macro"
End If
Selection = Words
End Sub

Private Function SetOnes(ByVal Number As Integer) As String
Dim OnesArray(9) As String
    OnesArray(1) = "One"
    OnesArray(2) = "Two"
    OnesArray(3) = "Three"
    OnesArray(4) = "Four"
    OnesArray(5) = "Five"
    OnesArray(6) = "Six"
    OnesArray(7) = "Seven"
    OnesArray(8) = "Eight"
    OnesArray(9) = "Nine"
    SetOnes = OnesArray(Number)
End Function

Private Function SetTens(ByVal Number As Integer) As String
Dim TensArray(9) As String
    TensArray(1) = "Ten"
    TensArray(2) = "Twenty"
    TensArray(3) = "Thirty"
    TensArray(4) = "Fourty"
    TensArray(5) = "Fifty"
    TensArray(6) = "Sixty"
    TensArray(7) = "Seventy"
    TensArray(8) = "Eighty"
    TensArray(9) = "Ninety"
Dim TeensArray(9) As String
    TeensArray(1) = "Eleven"
    TeensArray(2) = "Twelve"
    TeensArray(3) = "Thirteen"
    TeensArray(4) = "Fourteen"
    TeensArray(5) = "Fifteen"
    TeensArray(6) = "Sixteen"
    TeensArray(7) = "Seventeen"
    TeensArray(8) = "Eighteen"
    TeensArray(9) = "Nineteen"
Dim tmpInt1 As Integer
Dim tmpInt2 As Integer
Dim tmpString As String
    tmpInt1 = Int(Number / 10)
    tmpInt2 = Number Mod 10
    tmpString = TensArray(tmpInt1)
    If (tmpInt1 = 1 And tmpInt2 > 0) Then
        tmpString = TeensArray(tmpInt2)
    Else
        If (tmpInt1 > 1 And tmpInt2 > 0) Then
            tmpString = tmpString + " " + SetOnes(tmpInt2)
        End If
    End If
    SetTens = tmpString
End Function

Private Function SetHundreds(ByVal Number As Integer) As String
Dim tmpInt1 As Integer
Dim tmpInt2 As Integer
Dim tmpString As String
    tmpInt1 = Int(Number / 100)
    tmpInt2 = Number Mod 100
    If tmpInt1 > 0 Then tmpString = SetOnes(tmpInt1) + " Hundred"
    If tmpInt2 > 0 Then
        If tmpString > "" Then tmpString = tmpString + " "
        If tmpInt2 < 10 Then tmpString = tmpString + SetOnes(tmpInt2)
        If tmpInt2 > 9 Then tmpString = tmpString + SetTens(tmpInt2)
    End If
    SetHundreds = tmpString
End Function

Private Function SetThousands(ByVal Number As Long) As String
Dim tmpInt1 As Integer
Dim tmpInt2 As Integer
Dim tmpString As String
    tmpInt1 = Int(Number / 1000)
    tmpInt2 = Number - (tmpInt1 * 1000)
    If tmpInt1 > 0 Then tmpString = SetHundreds(tmpInt1) + " Thousand"
    If tmpInt2 > 0 Then
        If tmpString > "" Then tmpString = tmpString + " "
        tmpString = tmpString + SetHundreds(tmpInt2)
    End If
    SetThousands = tmpString
End Function

WordTips is your source for cost-effective Microsoft Word training. (Microsoft Word is the most popular word processing software in the world.) This tip (113) applies to Microsoft Word 97, 2000, 2002, and 2003.

Related Tips:

The First and Last Word on Word! Bestselling For Dummies author Dan Gookin puts his usual fun and friendly candor back to work to show you how to navigate Word 2013. Spend more time working and less time trying to figure it all out! Check out Word 2013 For Dummies today!

 

Leave your own comment:

*Name:
Email:
  Notify me about new comments ONLY FOR THIS TIP
Notify me about new comments ANYWHERE ON THIS SITE
Hide my email address
*Text:
*What is 5+3 (To prevent automated submissions and spam.)
 
 
           Commenting Terms

Comments for this tip:

Warren Belz    05 Sep 2016, 21:16
This might work a bit better - also:-

Puts a comma or "and" after thousands, millions etc depending if the next number is zero.
Puts "and" after hundreds if anything in tens or single.
Puts a dash (-) on the tens (twenty-five etc) if necessary.
Has an option to capitalise only the first letter of the string.

Public Function NumberSpell(ByVal MyNumber, Optional Caps As Boolean)
    
    Dim Dollars, Cents, Temp, WholeNo, WholeStr, FirstCap
    Dim DecimalPlace, Count
    ReDim place(9) As String
    
    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, "."): WholeNo = DecimalPlace - 1
    ' Find the length of the whole number
    If DecimalPlace > 0 Then
        WholeNo = DecimalPlace - 1
    Else: WholeNo = Len(MyNumber) 'this is when no decimal (integer)
    End If
    If WholeNo > 3 Then 'Set the thousand word depending on hundreds presence
        WholeStr = Mid(MyNumber, WholeNo - 2, 1) '100s place
        If WholeStr <> "0" Then
            place(2) = " Thousand, "
        Else: place(2) = " Thousand and "
        End If
    End If
    If WholeNo > 6 Then 'Set the millions word depending on hundred thousands
        WholeStr = Mid(MyNumber, WholeNo - 5, 1) '100,000s place
        If WholeStr <> "0" Then
            place(3) = " Million, "
        Else: place(3) = " Million and "
        End If
    End If
     If WholeNo > 9 Then 'Set the billions word depending on hundred millions presence
        WholeStr = Mid(MyNumber, WholeNo - 8, 1) '100,000,000s place
        If WholeStr <> "0" Then
            place(4) = " Billion, "
        Else: place(4) = " Billion and "
        End If
    End If
    If WholeNo > 12 Then 'Set the trillions word depending on hundred billions presence
        WholeStr = Mid(MyNumber, WholeNo - 11, 1) '100,000,000,000s place
        If WholeStr <> "0" Then
            place(5) = " Trillion, "
        Else: place(5) = " Trillion and "
        End If
    End If
    ' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    
    ' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else: MyNumber = ""
        End If
        Count = Count + 1
    Loop
    
    ' Set the dollar/s label
    Select Case Dollars
        Case "": Dollars = "No Dollars"
        Case "One": Dollars = "One Dollar"
        Case Else: Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case "": Cents = " and No Cents"
        Case "One": Cents = " and One Cent"
              Case Else: Cents = " and " & Cents & " Cents"
    End Select
    
    ' Put it all together
    Result = Replace(Dollars & Cents, " ", " ")
    
    ' If first cap only
    If Caps = True Then
        Result = LCase(Result) 'convert to lowever case
        FirstCap = UCase(Left(Result, 1)) 'capitalise first letter
        Result = FirstCap & Right(Result, Len(Result) - 1) 'add to remainder of string
    End If
    
    NumberSpell = Result
    
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 Mid(MyNumber, 2, 1) <> "0" Or Mid(MyNumber, 3, 1) <> "0" Then
            Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred and "
        Else: Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
        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, Intr, Dash 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
        ' Set the dash (-) when over nineteen and not even tens
        If Right(TensText, 1) <> "0" Then
            Dash = "-"
        Else: Dash = " "
        End If
        Result = Result & Dash & 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
abdulla khan    12 Mar 2015, 03:21
Excellent tips.

Thanks.
Denis    13 Mar 2012, 01:20
Hi, thank you for the macro. It's simple and efficient. However, if you actually try to convert 999999, you get an "overflow" error, which I think has to do with the CInt and Int functions.
Tries on MS Word2010.
 
 

Our Company

Sharon Parq Associates, Inc.

About Tips.Net

Contact Us

 

Advertise with Us

Our Privacy Policy

Our Sites

Tips.Net

Beauty and Style

Cars

Cleaning

Cooking

DriveTips (Google Drive)

ExcelTips (Excel 97–2003)

ExcelTips (Excel 2007–2016)

Gardening

Health

Home Improvement

Money and Finances

Organizing

Pests and Bugs

Pets and Animals

WindowsTips (Microsoft Windows)

WordTips (Word 97–2003)

WordTips (Word 2007–2016)

Our Products

Helpful E-books

Newsletter Archives

 

Excel Products

Word Products

Our Authors

Author Index

Write for Tips.Net

Copyright © 2016 Sharon Parq Associates, Inc.