The macro shown below will convert any Long number to the text
equivalent (both +ve and -ve).

Thanks must be given to:

http://exceltips.vitalnews.com/Pages/T0351_Numbers_Spelled_Out.html

who have the original version of this function.

The original version was limited to +ve numbers between 1 and 999999.
As such, it did not handle millions (which I wanted).

I've changed the macro to handle both millions and billions. As it was
easy to do, I also added the functionality to ahndle -ve number (as it
simply adds a 'Minus' string before the number).

A minor change I made to the original code was to add the word 'and'
after hundreds. 'Seven Hundred and Seventy Three' sounds better than
'Seven Hundred Seventry Three'. Most automated cheques add the 'and'
where it would naturally seem appropriate. This also occurs after
thousands, e.g. 'Seventenn thousand and Thirty Five'

I've tested various numbers and it seems OK as far as I can see. I've
not tried all 4 billion numbers so there may be errors in the macro
which I don't know about.

Anyway, I hope it is useful to you....

To use this macro (after you have added it to your workbook) simply
type into cell B1:

=NumberToWords(A1)

Then enter any number between -2147483647 and 2147483647 into A1. Cell
B1 will show the English text representation of your number.

The following functions need to be added to a module in the VBE for
the current workbook. (I hope you know how to do this!).

John.

' This function will convert all numbers between -2147483647 and
2147483647
' to a text string representing the number in plain English words.

Function NumberToWords(vCVal)

   Dim sWords As String
   Dim lNumber As Long

   sWords = ""
   If IsNumeric(vCVal) Then
     ' If the number cannot fit into a long (-2147483647 to
2147483647) CLng
     ' will throw an error #Value which will be returned back to the
caller.
     If vCVal = CLng(vCVal) Then
       lNumber = CLng(vCVal)
       Select Case lNumber
         Case -2147483647 To -1000000000
           sWords = "Minus " + SetBillions(Abs(lNumber))
         Case -1000000000 To -1000000
           sWords = "Minus " + SetMillions(Abs(lNumber))
         Case -999999 To -1
           sWords = "Minus " + SetThousands(Abs(lNumber))
         Case 0
           sWords = "Zero"
         Case 1 To 999999
           sWords = SetThousands(lNumber)
         Case 1000000 To 999999999
           sWords = SetMillions(lNumber)
         Case 1000000000 To 2147483647
           sWords = SetBillions(lNumber)
       End Select
       NumberToWords = sWords
     Else
       ' Is a number but not a whole number (e.g. 123.45)
       NumberToWords = CVErr(xlErrValue)
     End If
   Else
     ' Source is not a number
     NumberToWords = CVErr(xlErrValue)
   End If

End Function
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 + " and "
       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 + " "
       If iTemp2 < 100 And iTemp1 > 0 Then sTemp = sTemp + "and "
       sTemp = sTemp + SetHundreds(iTemp2)
   End If
   SetThousands = sTemp
End Function
Private Function SetMillions(ByVal lNumber As Long) As String
Dim iTemp1 As Long
Dim iTemp2 As Long
Dim sTemp As String
   iTemp1 = Int(lNumber / 1000000)
   iTemp2 = lNumber Mod 1000000
   If iTemp1 > 0 Then sTemp = SetThousands(iTemp1) + " Million"
   If iTemp2 > 0 Then
       If sTemp > "" Then sTemp = sTemp + " "
       sTemp = sTemp + SetThousands(iTemp2)
   End If
   SetMillions = sTemp
End Function
Private Function SetBillions(ByVal lNumber As Long) As String
Dim iTemp1 As Long
Dim iTemp2 As Long
Dim sTemp As String
   iTemp1 = Int(lNumber / 1000000000)
   iTemp2 = lNumber Mod 1000000000
   If iTemp1 > 0 Then sTemp = SetMillions(iTemp1) + " Billion"
   If iTemp2 > 0 Then
       If sTemp > "" Then sTemp = sTemp + " "
       sTemp = sTemp + SetMillions(iTemp2)
   End If
   SetBillions = sTemp
End Function