Loading

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.

With more than 50 non-fiction books and numerous magazine articles to his credit, Allen Wyatt is an internationally recognized author. He is president of Sharon Parq Associates, a computer and publishing services company.

Learn more about Allen...

ExcelTips FAQ

Ask an Excel Question

Make a Comment

Free Business Forms

Free Calendars

** Please Note:** This article is written for users of the following Microsoft Excel versions: 2007 and 2010. If you are using an earlier version (Excel 2003 or earlier),

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 (8351) applies to Microsoft Excel 2007 and 2010. You can find a version of this tip for the older menu interface of Excel here: Converting Numbers Into Words.

*Related Tips:*

**Change Formatting Based On Your Data!** Conditional formatting provides a way for you to adjust the appearance of your data based on the data itself. Discover how to put this amazingly powerful feature to work for you, today. This comprehensive volume is available in two editions. Check out *Excel Conditional Formatting* today!

Attribute VB_Name = "Module1spell"

Function SpellNumber(amt As Variant) As Variant

Dim FIGURE As Variant

Dim LENFIG As Integer

Dim i As Integer

Dim WORDs(19) As String

Dim tens(9) As String

WORDs(1) = "One"

WORDs(2) = "Two"

WORDs(3) = "Three"

WORDs(4) = "Four"

WORDs(5) = "Five"

WORDs(6) = "Six"

WORDs(7) = "Seven"

WORDs(8) = "Eight"

WORDs(9) = "Nine"

WORDs(10) = "Ten"

WORDs(11) = "Eleven"

WORDs(12) = "Twelve"

WORDs(13) = "Thirteen"

WORDs(14) = "Fourteen"

WORDs(15) = "Fifteen"

WORDs(16) = "Sixteen"

WORDs(17) = "Seventeen"

WORDs(18) = "Eighteen"

WORDs(19) = "Nineteen"

tens(2) = "Twenty"

tens(3) = "Thirty"

tens(4) = "Fourty"

tens(5) = "Fifty"

tens(6) = "Sixty"

tens(7) = "Seventy"

tens(8) = "Eighty"

tens(9) = "Ninety"

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

FIGLEN = Len(FIGURE)

If FIGLEN < 12 Then

FIGURE = Space(12 - FIGLEN) & FIGURE

End If

If Val(Left(FIGURE, 9)) > 1 Then

SpellNumber = "Rupees "

ElseIf Val(Left(FIGURE, 9)) = 1 Then

SpellNumber = "Rupee "

End If

For i = 1 To 3

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

If i = 1 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Crore "

ElseIf i = 2 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Lakh "

ElseIf i = 3 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Thousand "

End If

FIGURE = Mid(FIGURE, 3)

Next i

If Val(Left(FIGURE, 1)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 1))) + " Hundred "

End If

FIGURE = Mid(FIGURE, 2)

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

FIGURE = Mid(FIGURE, 4)

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Paise "

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

End If

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Only "

End If

End Function

Function SpellNumber(amt As Variant) As Variant

Dim FIGURE As Variant

Dim LENFIG As Integer

Dim i As Integer

Dim WORDs(19) As String

Dim tens(9) As String

WORDs(1) = "One"

WORDs(2) = "Two"

WORDs(3) = "Three"

WORDs(4) = "Four"

WORDs(5) = "Five"

WORDs(6) = "Six"

WORDs(7) = "Seven"

WORDs(8) = "Eight"

WORDs(9) = "Nine"

WORDs(10) = "Ten"

WORDs(11) = "Eleven"

WORDs(12) = "Twelve"

WORDs(13) = "Thirteen"

WORDs(14) = "Fourteen"

WORDs(15) = "Fifteen"

WORDs(16) = "Sixteen"

WORDs(17) = "Seventeen"

WORDs(18) = "Eighteen"

WORDs(19) = "Nineteen"

tens(2) = "Twenty"

tens(3) = "Thirty"

tens(4) = "Fourty"

tens(5) = "Fifty"

tens(6) = "Sixty"

tens(7) = "Seventy"

tens(8) = "Eighty"

tens(9) = "Ninety"

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

FIGLEN = Len(FIGURE)

If FIGLEN < 12 Then

FIGURE = Space(12 - FIGLEN) & FIGURE

End If

If Val(Left(FIGURE, 9)) > 1 Then

SpellNumber = "Rupees "

ElseIf Val(Left(FIGURE, 9)) = 1 Then

SpellNumber = "Rupee "

End If

For i = 1 To 3

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

If i = 1 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Crore "

ElseIf i = 2 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Lakh "

ElseIf i = 3 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Thousand "

End If

FIGURE = Mid(FIGURE, 3)

Next i

If Val(Left(FIGURE, 1)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 1))) + " Hundred "

End If

FIGURE = Mid(FIGURE, 2)

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

FIGURE = Mid(FIGURE, 4)

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Paise "

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

End If

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Only "

End If

End Function

Is there a code for changing a specific number into a specific word? (Not spelling the number out)

For example when I type the number 1 it automatically converts to the acronym RN.

Thanks!

For example when I type the number 1 it automatically converts to the acronym RN.

Thanks!

Here is a VBA function that converts positive decimal numbers of up to 15 digits (double) to words in dollars and cents that I found on Microsoft's Support site. I added the error return for negative numbers and the option of rounding or truncating.

Option Explicit

Public Function SpellNumber(ByVal Number As Double, Optional ByVal bRound As Boolean = False) As Variant

'Convert a decimal number to words in dollars and cents. Since Number is defined as double, a maximum

'of 15 digits will be used. Only the first two digits after the decimal point are used. If the decimal

'number does not contain a decimal point, then the decimal point is assumed to follow the right-most

'decimal number. Negative decimal numbers result in #VALUE!. By default (if bRound = False or is missing),

'Number is truncated after the second digit following the decimal point. If bRound = True, Number is rounded

'to the nearest whole cent.

'Adapted from Microsoft Support article "How to convert a numeric value into English words in Excel"

Dim Dollars, Cents, Temp, DecimalPlace, Count, MyNumber As String

'Limit the function to handling only non-negative decimal numbers

If Number < 0 Then

SpellNumber = CVErr(xlErrValue)

Exit Function

End If

ReDim Place(9) As String

Place(2) = " Thousand ": Place(3) = " Million ": Place(4) = " Billion ": Place(5) = " Trillion "

'Round Number to the nearest cent if bRound is True

If bRound Then Number = Round(Number, 2)

'String representation of amount

MyNumber = Trim(Str(Number))

'Position of decimal place at 0 if MyNumber does not have one

DecimalPlace = InStr(MyNumber, ".")

'Convert cents and set MyNumber to dollar amount

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Application.Trim(Dollars & Cents)

End Function

'Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

'Convert the hundreds place

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

'Convert the tens and ones place

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function

'Converts a number from 10 to 99 into text

Function GetTens(TensText)

Dim Result As String

Result = "" 'Null out the temporary function value

If Val(Left(TensText, 1)) = 1 Then 'If value between 10-19…

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else 'If value between 20-99…

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place.

End If

GetTens = Result

End Function

'Converts a number from 1 to 9 into text

Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function

Option Explicit

Public Function SpellNumber(ByVal Number As Double, Optional ByVal bRound As Boolean = False) As Variant

'Convert a decimal number to words in dollars and cents. Since Number is defined as double, a maximum

'of 15 digits will be used. Only the first two digits after the decimal point are used. If the decimal

'number does not contain a decimal point, then the decimal point is assumed to follow the right-most

'decimal number. Negative decimal numbers result in #VALUE!. By default (if bRound = False or is missing),

'Number is truncated after the second digit following the decimal point. If bRound = True, Number is rounded

'to the nearest whole cent.

'Adapted from Microsoft Support article "How to convert a numeric value into English words in Excel"

Dim Dollars, Cents, Temp, DecimalPlace, Count, MyNumber As String

'Limit the function to handling only non-negative decimal numbers

If Number < 0 Then

SpellNumber = CVErr(xlErrValue)

Exit Function

End If

ReDim Place(9) As String

Place(2) = " Thousand ": Place(3) = " Million ": Place(4) = " Billion ": Place(5) = " Trillion "

'Round Number to the nearest cent if bRound is True

If bRound Then Number = Round(Number, 2)

'String representation of amount

MyNumber = Trim(Str(Number))

'Position of decimal place at 0 if MyNumber does not have one

DecimalPlace = InStr(MyNumber, ".")

'Convert cents and set MyNumber to dollar amount

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Application.Trim(Dollars & Cents)

End Function

'Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

'Convert the hundreds place

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

'Convert the tens and ones place

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function

'Converts a number from 10 to 99 into text

Function GetTens(TensText)

Dim Result As String

Result = "" 'Null out the temporary function value

If Val(Left(TensText, 1)) = 1 Then 'If value between 10-19…

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else 'If value between 20-99…

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place.

End If

GetTens = Result

End Function

'Converts a number from 1 to 9 into text

Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function

Hi,

I have tried the above function its very useful string.

The only problem is after working when we close that particular excel sheet & again re open the same sheet then the above formula does not perform.

It seems its only temporary for one time

Can any one provide us the permanent solution that the above formula once pasted then it should last for ever in excel sheet .

I have tried the above function its very useful string.

The only problem is after working when we close that particular excel sheet & again re open the same sheet then the above formula does not perform.

It seems its only temporary for one time

Can any one provide us the permanent solution that the above formula once pasted then it should last for ever in excel sheet .

Or you could try this:

Instructions

1.Creating the Numbers-to-Words Function in Excel

1 Open the Microsoft Excel program.

2 Hold down the Alt key and press F11 to open the Visual Basic Editor.

3 Choose "Insert" from the main toolbar and click "Module."

4 Copy and paste or type the following Microsoft formula into the module:

Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

' String representation of amount.

MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _

"00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function

' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function

' Converts a number from 10 to 99 into text.

Function GetTens(TensText)

Dim Result As String

Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99...

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

End If

GetTens = Result

End Function

' Converts a number from 1 to 9 into text.

Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function

5 Choose SpellNumber from the module's pull-down menu.

Changing Numbers to Words in a Spreadsheet

6 Open an Excel spreadsheet.

7 Select the cell in which you want to convert numbers to text by clicking on the cell.

8 Click the Paste/Insert Function tab (fx).

9 Click "User Defined" in the left-hand menu and click "SpellNumber" in the right-hand menu.

10 Type in the number that you want converted to words.

11 Click "OK." The number will appear in the cell as text.

Read more: http://www.ehow.com/how_4797616_convert-numbers-words-ms-excel.html#ixzz2jDMUZu5k

Instructions

1.Creating the Numbers-to-Words Function in Excel

1 Open the Microsoft Excel program.

2 Hold down the Alt key and press F11 to open the Visual Basic Editor.

3 Choose "Insert" from the main toolbar and click "Module."

4 Copy and paste or type the following Microsoft formula into the module:

Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

' String representation of amount.

MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _

"00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function

' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function

' Converts a number from 10 to 99 into text.

Function GetTens(TensText)

Dim Result As String

Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99...

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

End If

GetTens = Result

End Function

' Converts a number from 1 to 9 into text.

Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function

5 Choose SpellNumber from the module's pull-down menu.

Changing Numbers to Words in a Spreadsheet

6 Open an Excel spreadsheet.

7 Select the cell in which you want to convert numbers to text by clicking on the cell.

8 Click the Paste/Insert Function tab (fx).

9 Click "User Defined" in the left-hand menu and click "SpellNumber" in the right-hand menu.

10 Type in the number that you want converted to words.

11 Click "OK." The number will appear in the cell as text.

Read more: http://www.ehow.com/how_4797616_convert-numbers-words-ms-excel.html#ixzz2jDMUZu5k

@Zoltan: I wouldn't dimension it as Byte, because then if you have more than 256 cells you will get an overflow error. In the year 2013 you can probably spare the 3 extra bytes required to dimension as Long, which will handle over 2.1 billion cells. (I skip over integer because it still has a relatively small range, plus I read somewhere once that the compiler redimensions as Long anyway, so it's less efficient). There are 17.1 billion cells in the "big grid", but we'll just have to settle for 2.1b....

Though really, I'd dimension as a Range, then do a For Each rng in Selection loop instead. Much cleaner.

Though really, I'd dimension as a Range, then do a For Each rng in Selection loop instead. Much cleaner.

NumberToWords is nice if you find yourself needing to permantly convert numbers to words, but I would think in most cases you'd rather have a function that does it (like BahtText, but... not in Thai). It turns out if you take the "Private" off of SetThousands you can use it as a UDF within a worksheet. As an added bonus, it now doesn't matter if the input is a formula, cell reference, or value.

You do have to modify it slightly to handle 0, since that's normally done within NumberToWords. All you have to do, though, is change the last line to:

SetThousands = IIf(Len(sTemp) > 0, sTemp, "Zero")

You do have to modify it slightly to handle 0, since that's normally done within NumberToWords. All you have to do, though, is change the last line to:

SetThousands = IIf(Len(sTemp) > 0, sTemp, "Zero")

In the For Next cycle lCtr is not defined so a new variable needs to be set as Dim lCtr As Byte. Of course you can only face this "small" error if the "Option Explicit" is defined before the sub. Option Explicit checks whether all of the variables are defined with a dim statement or not.

This is awesome just what I was after!!!

I wish it would do the cents, but I just added that on myself (using concatenate) and it made my job much easier when writing out cheques on a daily basis.

Thank you!! Totally rocks

I wish it would do the cents, but I just added that on myself (using concatenate) and it made my job much easier when writing out cheques on a daily basis.

Thank you!! Totally rocks