Excel 2003 Figures to Words Visual Basic Macro

It’s free code snippet day! I decided to put this one up because I’m a programmer and programmers need some code on them blogs.

Introduction and Background

Years ago, I supported a loans management application for the company’s savings and loans cooperative. They were in the business of issuing checks to the borrowers, and they needed an Excel macro to convert figures to words.

I had to design a macro for Microsoft Excel 2003 that did exactly that. I have to admit it looks redundant and inelegant, but it got the job done.

Now, this macro can only handle amounts up to 2,147,483,647.99. I suppose this is due to size limitations for the Double data type.

Note: Units are in Philippine PESOS. Of course you can change this if so desired.

Structure of the Macro Code

A brief explanation of the code… The calling function is ConvertFiguresToWords (yes, please change it to a nicer, friendlier sub name). The cell containing the figures to be converted into words is selected (active cell), and the macro is run. The cell to the right of the source cell displays the words corresponding to the figures.

Just copy all of the snippets into a macro module inside your Excel file, and test! If you have comments or suggestions on how to improve the code, feel free to drop me a comment. Please keep an eagle eye out for errors! Peer review rules.

ConvertFigurestToWords

Sub ConvertFiguresToWords()
Dim dblAmount As Double

On Error Resume Next

dblAmount = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = getWords(dblAmount)

Exit Sub

End Sub

getWords – The next function does most of the heavy lifting, calling child functions to provide the complete translation from figures to words. There are three main sections to this function: a part that calls the parsing function, one that translates for the whole number part, and the last one translates for the decimal part.

The results of the child functions (corresponding to a token) are combined to form the output string.

Function getWords(argFigures As Double) As String
Dim nA() As Double
Dim dblDec As Double, dblWhole As Double
Dim dblRem As Double, dblTemp As Double, dblPrev As Double
Dim iCtr As Integer
Dim strWhole As String, strDec As String, strTemp As String

On Error GoTo ErrorMsg
dblWhole = Fix(argFigures)
dblDec = Round((argFigures - dblWhole), 2) * 100
nA() = parseFigure(dblWhole)

'Whole numbers
If dblWhole > 0 Then
For iCtr = 0 To UBound(nA)
strTemp = ""

Select Case iCtr
Case 0
If nA(iCtr + 1) <> 1 Then
strTemp = getOnes(nA(iCtr))
End If
Case 1, 4, 7, 10
If nA(iCtr) = 1 Then
strTemp = getTeens(nA(iCtr - 1) + 10)
ElseIf nA(iCtr) > 1 Then
strTemp = getTens(nA(iCtr))
End If
Case 2, 5, 8, 11
If nA(iCtr) > 0 Then
strTemp = getOnes(nA(iCtr)) & "HUNDRED "
End If
Case 3
If nA(iCtr) > 0 And nA(iCtr + 1) <> 1 Then
strTemp = getOnes(nA(iCtr)) & "THOUSAND "
ElseIf (nA(iCtr) + nA(iCtr + 1) + nA(iCtr + 2)) > 0 Then
strTemp = "THOUSAND "
End If
Case 6
If nA(iCtr) > 0 And nA(iCtr + 1) <> 1 Then
strTemp = getOnes(nA(iCtr)) & "MILLION "
ElseIf (nA(iCtr) + nA(iCtr + 1) + nA(iCtr + 2)) > 0 Then
strTemp = "MILLION "
End If
Case 9
If nA(iCtr) > 0 Then
strTemp = getOnes(nA(iCtr)) & "BILLION "
End If
End Select

strWhole = strTemp & strWhole
Next iCtr
Else
strWhole = "ZERO "
End If

'Decimal part
iCtr = 0
If dblDec > 0 Then
Do While dblDec > 0 And iCtr < 2
strTemp = ""
dblRem = dblDec Mod 10
dblDec = Fix(dblDec / 10)
dblTemp = dblDec Mod 10

If iCtr = 0 And dblTemp <> 1 Then
strTemp = getOnes(dblRem)
ElseIf iCtr = 1 And dblRem > 1 Then
strTemp = getTens(dblRem)
ElseIf iCtr = 1 And dblRem = 1 Then
strTemp = getTeens(dblPrev + 10)
End If

dblPrev = dblRem
iCtr = iCtr + 1

strDec = strTemp & strDec
Loop
Else
strDec = "ZERO "
End If

getFigures = strWhole & "PESO/S AND " & strDec & "CENTAVOS"

Exit Function
ErrorMsg:
getFigures = "ERROR!!! MAX VALUE IS 2,147,483,647.99."
End Function

getOnes – As the name implies, returns the words for the “Ones” types of numbers (One to Nine).

Function getOnes(argDigit As Double) As String
Select Case argDigit
Case 1
getOnes = "ONE "
Exit Function
Case 2
getOnes = "TWO "
Exit Function
Case 3
getOnes = "THREE "
Exit Function
Case 4
getOnes = "FOUR "
Exit Function
Case 5
getOnes = "FIVE "
Exit Function
Case 6
getOnes = "SIX "
Exit Function
Case 7
getOnes = "SEVEN "
Exit Function
Case 8
getOnes = "EIGHT "
Exit Function
Case 9
getOnes = "NINE "
Exit Function
End Select
End Function

getTeens – Another function that takes care of translating from Ten to Nineteen.

Function getTeens(argDigit As Double) As String
Select Case argDigit
Case 10
getTeens = "TEN "
Exit Function
Case 11
getTeens = "ELEVEN "
Exit Function
Case 12
getTeens = "TWELVE "
Exit Function
Case 13
getTeens = "THIRTEEN "
Exit Function
Case 14
getTeens = "FOURTEEN "
Exit Function
Case 15
getTeens = "FIFTEEN "
Exit Function
Case 16
getTeens = "SIXTEEN "
Exit Function
Case 17
getTeens = "SEVENTEEN "
Exit Function
Case 18
getTeens = "EIGHTEEN "
Exit Function
Case 19
getTeens = "NINETEEN "
Exit Function
End Select
End Function

getTens – Remember being taught as a preschooler how to count by tens? It will come in handy for this next one.

Function getTens(argDigit As Double) As String
Select Case argDigit
Case 2
getTens = "TWENTY "
Exit Function
Case 3
getTens = "THIRTY "
Exit Function
Case 4
getTens = "FORTY "
Exit Function
Case 5
getTens = "FIFTY "
Exit Function
Case 6
getTens = "SIXTY "
Exit Function
Case 7
getTens = "SEVENTY "
Exit Function
Case 8
getTens = "EIGHTY "
Exit Function
Case 9
getTens = "NINETY "
Exit Function
End Select
End Function

parseFigure – Last, but not the least, parses the numbers/figures into an array for easier conversion.

Function parseFigure(argFigures As Double) As Double()
Dim retArray(10) As Double
Dim dblWhole As Double
Dim iCtr As Integer

iCtr = 0
dblWhole = argFigures

Do While dblWhole > 0 And iCtr < UBound(retArray)
retArray(iCtr) = dblWhole Mod 10
dblWhole = Fix(dblWhole / 10)
iCtr = iCtr + 1
Loop

parseFigure = retArray
End Function