**Please Note: **
This article is written for users of the following Microsoft Excel versions: 2007, 2010, 2013, 2016, 2019, and Excel in Microsoft 365. If you are using an earlier version (Excel 2003 or earlier), *this tip may not work for you*. For a version of this tip written specifically for earlier versions of Excel, click here: Converting Numbers Into Words.

Written by Allen Wyatt (last updated March 12, 2022)**This tip applies to** Excel 2007, 2010, 2013, 2016, 2019, and Excel in Microsoft 365

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 lCtr 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) = "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 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 (8351) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, and Excel in Microsoft 365. You can find a version of this tip for the older menu interface of Excel here: **Converting Numbers Into Words**.

**Create Custom Apps with VBA!** Discover how to extend the capabilities of Office 2013 (Word, Excel, PowerPoint, Outlook, and Access) with VBA programming, using it for writing macros, automating Office applications, and creating custom applications. Check out *Mastering VBA for Office 2013* today!

Excel allows you to specify the RGB (red, green, and blue) value for any color used in a cell. Here's a quick way to see ...

Discover MoreNeed to get rid of extraneous spaces before or after the text in a string? VBA provides three different functions you can ...

Discover MoreChemical formulas use a notation that shows the elements and the number of atoms of that element that comprise each ...

Discover More**FREE SERVICE:** Get tips like this every week in *ExcelTips,* a free productivity newsletter. Enter your address and click "Subscribe."

2022-03-25 12:26:41

kiwerry

Thanks, Peter 👍

2022-03-23 06:43:01

Peter

2022-03-23 04:15:23

Kiwerry

@Mike: Thanks for the heads-up - this time it worked.

2022-03-22 04:24:54

Mike

@Kiwerry: It might be worth one more try - I just tested it and it was back.

2022-03-21 06:39:44

Kiwerry

2022-03-20 06:07:30

Peter

from ttps://www.techrepublic.com/article/10-power-tricks-for-using-word-field-switches/)

2022-03-20 05:19:09

Kiwerry

2022-03-19 05:07:11

Mike

https://www.extendoffice.com/documents/excel/1446-excel-convert-change-numbers-to-words.html

Much longer than Willy Vanhaelen's version, but handles 15 digit precision, including decimals, so up to 999 Trillion and down to 0.000000000000001

2022-03-18 11:13:50

Sandeep Kothari

Woolley

thanks.

2022-03-18 10:30:19

J. Woolley

https://www.wiley.com/en-us/Excel+2013+Power+Programming+with+VBA-p-9781118490396#downloads-section

2022-03-18 10:05:13

Sandeep Kothari

Kimberly, Pl share your code. my email id is sandeepkothari2010@gmail.com.

thanks.

2022-03-17 11:39:51

Willy Vanhaelen

Thinking that a user defined function (UDF) version would be more useful I decided to adapt it and while doing so I found that, especially the three functions, are prone to compaction. This can be achieved by using the Split method which makes the making of the arrays considerably shorter.

Declaring the sTemp, iTemp1 and iTemp2 variables in each function, assigning the result of a rather simple formula like "lNumber Mod 10" to them and then use it only a few times is rather cumbersome. In this case I prefer to put those formulas directly where they are needed. This also makes easier to understand the working of the function:

SetOnces(Nr Mod 10) is easier than SetOnes(iTemp2). What is it again what iTemp2 contains? :-)

Here is the result of my work (only half the size of the macro):

Function Number2Words(Nr)

If Not IsNumeric(Nr) Then GoTo wrong

If Nr <> CLng(Nr) Then GoTo wrong

Nr = CLng(Nr)

Select Case Nr

Case 0: Number2Words = "Zero"

Case 1 To 999999: Number2Words = SetThousands(Nr)

Case Else: GoTo wrong

End Select

Exit Function

wrong:

Number2Words = "Argument must be a positive integer max. 999999"

End Function

Private Function SetOnes(ByVal Nr As Integer) As String

SetOnes = Split("0 One Two Three Four Five Six Seven Eight Nine")(Nr)

End Function

Private Function SetTens(ByVal Nr As Integer) As String

If Nr > 10 And Nr < 20 Then

SetTens = Split("0 Eleven Twelve Thirteen Fourteen Fifteen" _

& " Sixteen Seventeen Eighteen Nineteen")(Nr - 10)

Else

SetTens=Split("0 Ten Twenty Thirty Fourty Fifty Sixty Seventy Eighty Ninety")(Nr\10)

If Nr Mod 10 > 0 Then SetTens = SetTens & " " & SetOnes(Nr Mod 10)

End If

End Function

Private Function SetHundreds(ByVal Nr As Integer) As String

If Nr \ 100 Then SetHundreds = SetOnes(Nr \ 100) & " Hundred"

If Nr Mod 100 > 0 Then

If SetHundreds > "" Then SetHundreds = SetHundreds & " "

If Nr Mod 100 < 10 Then SetHundreds = SetHundreds & SetOnes(Nr Mod 100)

If Nr Mod 100 > 9 Then SetHundreds = SetHundreds & SetTens(Nr Mod 100)

End If

End Function

Private Function SetThousands(ByVal Nr As Long) As String

If Nr \ 1000 > 0 Then SetThousands = SetHundreds(Nr \ 1000) & " Thousand"

If Nr Mod 1000 > 0 Then

If SetThousands > "" Then SetThousands = SetThousands & " "

SetThousands = SetThousands & SetHundreds(Nr Mod 1000)

End If

End Function

To use this UDF enter either =Number2Words(1234) in any cell or if cell A1 contains a number you can enter in cell B2 =Number2Words(A1).

2022-03-13 06:33:59

Kiwerry

Pity there seems to be no way to use User Defined Functions in Word as well.

2022-03-12 11:05:16

J. Woolley

SpellDecimal(Amount)

SpellDollars(Amount)

SpellOrdinal(Amount)

Amount can have up to 15 significant digits.

Here are examples results for Amount=123.456:

One Hundred Twenty-Three point Four Five Six

One Hundred Twenty-Three & 46/100 Dollars

One Hundred Twenty-Third

See https://sites.google.com/view/MyExcelToolbox/

2022-03-12 08:35:17

Kiwerry

I did some tweaking so that it can handle numbers between -999999 and + 999999 (as is it doesn't translate negative numbers), and used your sub as the basis for a complementary function which may be used as a user-defined function.

I also added some coding to check the application language ID and add the word "and" for UK, South African, New Zealand, Australian and Irish installations. This so that, for example, 123 translates to "One Hundred and Twenty Three"

If anyone is interested in the code leave a comment here and I'll post it.

Got a version of Excel that uses the
ribbon interface (Excel 2007 or later)?
**This site is for you!** If you
use an earlier version of Excel, visit
our *ExcelTips* site focusing on the menu interface.

**FREE SERVICE:** Get tips like this every week in *ExcelTips,* a free productivity newsletter. Enter your address and click "Subscribe."

Copyright © 2024 Sharon Parq Associates, Inc.

## Comments