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