Converting Numbers Into 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." The following macro, NumberToWords, does just that. It is rather long, but it has to do a lot of checking to put together the proper string. There are actually five macros in the set; the four besides NumberToWords are called by NumberToWords to do the actual conversion.

NumberToWords will convert any number between 0 and 999,999. To use it, simply select the cell (or cells) whose contents you want to convert, then run it. You should note that the cells must contain whole number values, not formulas that result in whole number values. The actual contents of the compliant cells are changed from the original number to a text representation of that number. In other words, this is not a format change, but a value change for those cells.

Sub NumberToWords()
    Dim rngSrc As Range
    Dim lMax As Long
    Dim bNCFlag As Boolean
    Dim sTitle As String, sMsg As String
    Dim vCVal As Variant
    Dim lNumber As Long, sWords As String

    Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
    lMax = rngSrc.Cells.Count

    bNCFlag = False
    For lCtr = 1 To lMax
        vCVal = rngSrc.Cells(lCtr).Value
        sWords = ""
        If IsNumeric(vCVal) Then
            If vCVal <> CLng(vCVal) Then
                bNCFlag = True
            Else
                lNumber = CLng(vCVal)
                Select Case lNumber
                Case 0
                    sWords = "Zero"
                Case 1 To 999999
                    sWords = SetThousands(lNumber)
                Case Else
                    bNCFlag = True
                End Select
            End If
        Else
            bNCFlag = True
        End If
        If sWords > "" Then
            rngSrc.Cells(lCtr) = sWords
        End If
    Next lCtr

    If bNCFlag Then
        sTitle = "lNumberToWords Macro"
        sMsg = "Not all cells converted. May not be whole number or may be too large."
        MsgBox sMsg, vbExclamation, sTitle
    End If
End Sub

Private Function SetOnes(ByVal lNumber 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(lNumber)
End Function

Private Function SetTens(ByVal lNumber As Integer) As String
Dim TensArray(9) As String
    TensArray(1) = "Ten"
    TensArray(2) = "Twenty"
    TensArray(3) = "Thirty"
    TensArray(4) = "Forty"
    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 iTemp1 As Integer
Dim iTemp2 As Integer
Dim sTemp As String
    iTemp1 = Int(lNumber / 10)
    iTemp2 = lNumber Mod 10
    sTemp = TensArray(iTemp1)
    If (iTemp1 = 1 And iTemp2 > 0) Then
        sTemp = TeensArray(iTemp2)
    Else
        If (iTemp1 > 1 And iTemp2 > 0) Then
            sTemp = sTemp + " " + SetOnes(iTemp2)
        End If
    End If
    SetTens = sTemp
End Function

Private Function SetHundreds(ByVal lNumber As Integer) As String
Dim iTemp1 As Integer
Dim iTemp2 As Integer
Dim sTemp As String
    iTemp1 = Int(lNumber / 100)
    iTemp2 = lNumber Mod 100
    If iTemp1 > 0 Then sTemp = SetOnes(iTemp1) + " Hundred"
    If iTemp2 > 0 Then
        If sTemp > "" Then sTemp = sTemp + " "
        If iTemp2 < 10 Then sTemp = sTemp + SetOnes(iTemp2)
        If iTemp2 > 9 Then sTemp = sTemp + SetTens(iTemp2)
    End If
    SetHundreds = sTemp
End Function

Private Function SetThousands(ByVal lNumber As Long) As String
Dim iTemp1 As Integer
Dim iTemp2 As Integer
Dim sTemp As String
    iTemp1 = Int(lNumber / 1000)
    iTemp2 = lNumber Mod 1000
    If iTemp1 > 0 Then sTemp = SetHundreds(iTemp1) + " Thousand"
    If iTemp2 > 0 Then
        If sTemp > "" Then sTemp = sTemp + " "
        sTemp = sTemp + SetHundreds(iTemp2)
    End If
    SetThousands = sTemp
End Function

ExcelTips is your source for cost-effective Microsoft Excel training. This tip (2270) applies to Microsoft Excel 97, 2000, 2002, and 2003. You can find a version of this tip for the ribbon interface of Excel (Excel 2007 and later) here: Converting Numbers Into Words.