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.
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
One thought on “Excel 2003 Figures to Words Visual Basic Macro”
Pingback: SOPA Can Pry My Infringing LOLCats From My Cold, Dead Carpal Tunnel Hands « Mental Detritus