**Please Note: **
This article is written for users of the following Microsoft Excel versions: 2007, 2010, and 2013. 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.

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, and 2013. 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!

You can easily add a button to your worksheet that will allow you to run various macros. This tip shows how easy it is.

Discover MoreDo your macros seem to be disabled on your new machine? It could be because of the security settings in Excel. Here's ...

Discover MoreFiguring out where Windows places certain items (such as the user's desktop) can be a bit frustrating. Fortunately, there ...

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

2017-01-30 00:22:59

narz

2017-01-17 22:15:25

jansen

2017-01-17 05:35:14

kajappa

Dear Sir

Let me know the words to type in the cell

to convert number to words

2016-08-30 01:17:53

Naeem Bakurally

e.g. for 0.25 cents

"and Twenty Five Cents"

Is it possible to add another case where the word "and" does not appear?

i.e for the above example it reads only

"Twenty Five Cents"

Thank you.

Naeem

2016-07-29 09:46:58

poojan

1500000 = fiftyn lakes show but not show this formula

2016-05-30 01:46:57

2016-04-05 04:15:20

Mujtaba Yasir

Please tell me how the numeric words convert to English translation

2016-04-02 21:50:20

I tested this Macro.. very good result came.. thank you for your kind work and excellency..

At the same time, I want write the numbers in one by one in CELL "A1 - to - A25" as 101 , 102 , 103, . .. like this... and Result Come in same Row in "B" Columns.... sir. i.e... Result will come in B1,B2,B3 . . .andso on.. . sir.

How it make.. How is write macro ? can you Pls.. Help... this..

Pls. reply sir. thank you sir.

2016-04-01 08:19:30

shiv

2. ' Edited by Karthikeyan karthikeyan@livetolearn.in

3. Dim Temp

4. Dim Rupees, Paise

5. Dim DecimalPlace, Count

6.

7. ReDim Place(9) As String

8. Place(2) = " Thousand "

9. Place(3) = " lakh "

10. Place(4) = " Crore "

11.

12.

13. ' Convert MyNumber to a string, trimming extra spaces.

14. MyNumber = Trim(Str(MyNumber))

15.

16. ' Find decimal place.

17. DecimalPlace = InStr(MyNumber, ".")

18.

19. ' If we find decimal place...

20. If DecimalPlace > 0 Then

21. ' Convert Paise

22. Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)

23. ' Hi! Note the above line Mid function it gives right portion

24. ' after the decimal point

25. 'if only . and no numbers such as 789. accures, mid returns nothing

26. ' to avoid error we added 00

27. ' Left function gives only left portion of the string with specified places here 2

28.

29.

30. Paise = ConvertTens(Temp)

31.

32.

33. ' Strip off paise from remainder to convert.

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

35. End If

36.

37. Count = 1

38. If MyNumber <> "" Then

39.

40. ' Convert last 3 digits of MyNumber to Indian Rupees.

41. Temp = ConvertHundreds(Right(MyNumber, 3))

42.

43. If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees

44.

45. If Len(MyNumber) > 3 Then

46. ' Remove last 3 converted digits from MyNumber.

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

48. Else

49. MyNumber = ""

50. End If

51.

52. End If

53.

54. ' convert last two digits to of mynumber

55. Count = 2

56.

57. Do While MyNumber <> ""

58. Temp = ConvertTens(Right("0" & MyNumber, 2))

59.

60. If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees

61. If Len(MyNumber) > 2 Then

62. ' Remove last 2 converted digits from MyNumber.

63. MyNumber = Left(MyNumber, Len(MyNumber) - 2)

64.

65. Else

66. MyNumber = ""

67. End If

68. Count = Count + 1

69.

70. Loop

71.

72.

73.

74.

75. ' Clean up dollars.

76. Select Case Rupees

77. Case ""

78. Rupees = "Rupees"

79. Case "One"

80. Rupees = "One Rupee"

81. Case Else

82. Rupees = Rupees & " Rupees"

83. End Select

84.

85. ' Clean up cents.

86. Select Case Paise

87. Case ""

88. Paise = ""

89. Case "One"

90. Paise = " And One Paise"

91. Case Else

92. Paise = " And " & Paise & " Paise"

93. End Select

94.

95. ConvertCurrencyToEnglish = Rupees & Paise

96. End Function

97.

98.

99. Private Function ConvertDigit(ByVal MyDigit)

100. Select Case Val(MyDigit)

101. Case 1: ConvertDigit = "One"

102. Case 2: ConvertDigit = "Two"

103. Case 3: ConvertDigit = "Three"

104. Case 4: ConvertDigit = "Four"

105. Case 5: ConvertDigit = "Five"

106. Case 6: ConvertDigit = "Six"

107. Case 7: ConvertDigit = "Seven"

108. Case 8: ConvertDigit = "Eight"

109. Case 9: ConvertDigit = "Nine"

110. Case Else: ConvertDigit = ""

111. End Select

112.

113. End Function

114.

115. Private Function ConvertHundreds(ByVal MyNumber)

116. Dim Result As String

117.

118. ' Exit if there is nothing to convert.

119. If Val(MyNumber) = 0 Then Exit Function

120.

121. ' Append leading zeros to number.

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

123.

124. ' Do we have a hundreds place digit to convert?

125. If Left(MyNumber, 1) <> "0" Then

126. Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "

127. End If

128.

129. ' Do we have a tens place digit to convert?

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

131. Result = Result & ConvertTens(Mid(MyNumber, 2))

132. Else

133. ' If not, then convert the ones place digit.

134. Result = Result & ConvertDigit(Mid(MyNumber, 3))

135. End If

136.

137. ConvertHundreds = Trim(Result)

138. End Function

139.

140.

141. Private Function ConvertTens(ByVal MyTens)

142. Dim Result As String

143.

144. ' Is value between 10 and 19?

145. If Val(Left(MyTens, 1)) = 1 Then

146. Select Case Val(MyTens)

147. Case 10: Result = "Ten"

148. Case 11: Result = "Eleven"

149. Case 12: Result = "Twelve"

150. Case 13: Result = "Thirteen"

151. Case 14: Result = "Fourteen"

152. Case 15: Result = "Fifteen"

153. Case 16: Result = "Sixteen"

154. Case 17: Result = "Seventeen"

155. Case 18: Result = "Eighteen"

156. Case 19: Result = "Nineteen"

157. Case Else

158. End Select

159. Else

160. ' .. otherwise it's between 20 and 99.

161. Select Case Val(Left(MyTens, 1))

162. Case 2: Result = "Twenty "

163. Case 3: Result = "Thirty "

164. Case 4: Result = "Forty "

165. Case 5: Result = "Fifty "

166. Case 6: Result = "Sixty "

167. Case 7: Result = "Seventy "

168. Case 8: Result = "Eighty "

169. Case 9: Result = "Ninety "

170. Case Else

171. End Select

172.

173. ' Convert ones place digit.

174. Result = Result & ConvertDigit(Right(MyTens, 1))

175. End If

176.

177. ConvertTens = Result

178. End Function

2016-03-01 15:56:32

Abrar Ahmad

thanks

2016-01-26 00:28:12

Tee

Please tell me how to run the above macro to convert numbers to words in excel. I don't understand how to get the code into the excel workbook that I want to use it in.

Thanks,

Tee

2015-10-30 06:08:11

DIVYESH

plz tell me how to convert numbers into words in Ms Excel

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 © 2019 Sharon Parq Associates, Inc.

## Comments