Convert numers to words for check/Cheque printing.

Here is something I have posted in the past to the old newsgroups which you might find useful...

Go into the VB Editor (Alt+F11) and add a Module to the Workbook (Insert/Module from the VBA menu) and then paste in all of the code appearing after my signature into the Module's code window. You can call the function from your work sheet like this =NumberAsText(A1) where A1 is assumed to hold the number you want to convert. There is an Optional argument you can use to format the results to your liking. Here are some examples to show the options available...

A1:  123.45

In B1:

=NumberAsText(A1)  ==>  One Hundred Twenty Three Point Four Five

=NumberAsText(A1,"And")  ==>  One Hundred and Twenty Three Point Four Five

=NumberAsText(A1,"Check")  ==>  One Hundred Twenty Three and 45/100

=NumberAsText(A1,"Dollar")  ==>  One Hundred Twenty Three Dollars and Forty Five Cents

=NumberAsText(A1,"CheckDollar")  ==> One Hundred Twenty Three Dollars and 45/100

To summarize, using "And" adds the word "and" in front of the tens/units text; using "Check" formats any decimal values as would be written on a check; and using "Dollar" adds the words "Dollars" and "Cents" in their appropriate positions. The code is laid out in a reasonably straight forward manner, so if Dollars/Cents is not you native currency designation, you should be able to modify the program accordingly. In addition to the above, for all modes, the Plus and Minus sign can be used and will be reported back as a word; commas may be used to separate the numbers to the left of the decimal point but they will not be reported back by the routine and are permitted for the users convenience (however, if commas are used, they must be placed in their correct positions). And, finally,if I remember correctly, this function will work with a whole number part up to one less than a quintillion (you can have as many decimal places as desired), but remember to format large numbers as Text values... otherwise VB will convert large non-Text values to Doubles (which will destroy the conversion).

Private sNumberText() As String

Public Function NumberAsText(NumberIn As Variant, Optional _

                AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR As String) As String

   Dim cnt As Long

   Dim DecimalPoint As Long

   Dim CardinalNumber As Long

   Dim CommaAdjuster As Long

   Dim TestValue As Long

   Dim CurrValue As Currency

   Dim CentsString As String

   Dim NumberSign As String

   Dim WholePart As String

   Dim BigWholePart As String

   Dim DecimalPart As String

   Dim tmp As String

   Dim sStyle As String

   Dim bUseAnd As Boolean

   Dim bUseCheck As Boolean

   Dim bUseDollars As Boolean

   Dim bUseCheckDollar As Boolean

  '----------------------------------------

  '  Begin setting conditions for formatting

  '----------------------------------------

  '  Determine whether to apply special formatting.

  '  If nothing passed, return routine result

  '  converted only into its numeric equivalents,

  '  with no additional format text.

   sStyle = LCase(AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR)

  '  User passed "AND": "and" will be added

  '  between hundredths and tens of dollars,

  '  ie "Three Hundred and Forty Two"

   bUseAnd = sStyle = "and"

  '  User passed "DOLLAR": "dollar(s)" and "cents"

  '  appended to string,

  '  ie "Three Hundred and Forty Two Dollars"

   bUseDollars = sStyle = "dollar"

  '  User passed "CHECK" *or* "DOLLAR"

  '  If "check", cent amount returned as a fraction /100

  '  i.e. "Three Hundred Forty Two and 00/100"

  '  If "dollar" was passed, "dollar(s)" and "cents"

  '  Appended instead.

   bUseCheck = (sStyle = "check") Or (sStyle = "dollar")

   bUseCheckDollar = sStyle = "checkdollar"

  '----------------------------------------

  '  Check/create array. If this is the first

  '  time using this routine, create the text

  '  strings that will be used.

  '----------------------------------------

   If Not IsBounded(sNumberText) Then

      Call BuildArray(sNumberText)

   End If

  '----------------------------------------

  '  Begin validating the number, and breaking

  '  into constituent parts

  '----------------------------------------

  '  Prepare to check for valid value in

   NumberIn = Trim$(NumberIn)

   If Not IsNumeric(NumberIn) Then

     '  Invalid entry - abort

      NumberAsText = "Error - Number improperly formed"

      Exit Function

   Else

     '  Decimal check

      DecimalPoint = InStr(NumberIn, ".")

      If DecimalPoint > 0 Then

        '  Split the fractional and primary numbers

         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)

         WholePart = Left$(NumberIn, DecimalPoint - 1)

      Else

        '  Assume the decimal is the last char

         DecimalPoint = Len(NumberIn) + 1

         WholePart = NumberIn

      End If

      If InStr(NumberIn, ",,") Or _

         InStr(NumberIn, ",.") Or _

         InStr(NumberIn, ".,") Or _

         InStr(DecimalPart, ",") Then

         NumberAsText = "Error - Improper use of commas"

         Exit Function

      ElseIf InStr(NumberIn, ",") Then

         CommaAdjuster = 0

         WholePart = ""

         For cnt = DecimalPoint - 1 To 1 Step -1

            If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then

               WholePart = Mid$(NumberIn, cnt, 1) & WholePart

            Else

               CommaAdjuster = CommaAdjuster + 1

               If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then

                  NumberAsText = "Error - Improper use of commas"

                  Exit Function

               End If

            End If

         Next

      End If

   End If

   If Left$(WholePart, 1) Like "[+-]" Then

      NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")

      WholePart = Mid$(WholePart, 2)

   End If

  '----------------------------------------

  '  Begin code to assure decimal portion of

  '  check value is not inadvertently rounded

  '----------------------------------------

   If bUseCheck = True Then

      CurrValue = CCur(Val("." & DecimalPart))

      DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)

      If CurrValue >= 0.995 Then

         If WholePart = String$(Len(WholePart), "9") Then

            WholePart = "1" & String$(Len(WholePart), "0")

         Else

            For cnt = Len(WholePart) To 1 Step -1

              If Mid$(WholePart, cnt, 1) = "9" Then

                 Mid$(WholePart, cnt, 1) = "0"

              Else

                 Mid$(WholePart, cnt, 1) = _

                            CStr(Val(Mid$(WholePart, cnt, 1)) + 1)

                 Exit For

              End If

            Next

         End If

      End If

   End If

  '----------------------------------------

  '  Final prep step - this assures number

  '  within range of formatting code below

  '----------------------------------------

   If Len(WholePart) > 9 Then

      BigWholePart = Left$(WholePart, Len(WholePart) - 9)

      WholePart = Right$(WholePart, 9)

   End If

   If Len(BigWholePart) > 9 Then

      NumberAsText = "Error - Number too large"

      Exit Function

   ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _

         (Not BigWholePart Like String$(Len(BigWholePart), "#") _

          And Len(BigWholePart) > 0) Then

      NumberAsText = "Error - Number improperly formed"

      Exit Function

   End If

  '----------------------------------------

  '  Begin creating the output string

  '----------------------------------------

  '  Very Large values

   TestValue = Val(BigWholePart)

   If TestValue > 999999 Then

      CardinalNumber = TestValue \ 1000000

      tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "

      TestValue = TestValue - (CardinalNumber * 1000000)

   End If

   If TestValue > 999 Then

     CardinalNumber = TestValue \ 1000

     tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "

     TestValue = TestValue - (CardinalNumber * 1000)

   End If

   If TestValue > 0 Then

      tmp = tmp & HundredsTensUnits(TestValue) & "Billion "

   End If

  '  Lesser values

   TestValue = Val(WholePart)

   If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "

   If TestValue > 999999 Then

      CardinalNumber = TestValue \ 1000000

      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "

      TestValue = TestValue - (CardinalNumber * 1000000)

   End If

   If TestValue > 999 Then

      CardinalNumber = TestValue \ 1000

      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "

      TestValue = TestValue - (CardinalNumber * 1000)

   End If

   If TestValue > 0 Then

      If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False

      tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)

   End If

  '  If in dollar mode, assure the text is the correct plurality

   If bUseDollars = True Then

      CentsString = HundredsTensUnits(DecimalPart)

      If tmp = "One " Then

         tmp = tmp & "Dollar"

      Else

         tmp = tmp & "Dollars"

      End If

      If Len(CentsString) > 0 Then

         tmp = tmp & " and " & CentsString

         If CentsString = "One " Then

            tmp = tmp & "Cent"

         Else

            tmp = tmp & "Cents"

         End If

      End If

   ElseIf bUseCheck = True Then

      tmp = tmp & "and " & Left$(DecimalPart & "00", 2)

      tmp = tmp & "/100"

   ElseIf bUseCheckDollar = True Then

      If tmp = "One " Then

         tmp = tmp & "Dollar"

      Else

         tmp = tmp & "Dollars"

      End If

      tmp = tmp & " and " & Left$(DecimalPart & "00", 2)

      tmp = tmp & "/100"

   Else

      If Len(DecimalPart) > 0 Then

        tmp = tmp & "Point"

        For cnt = 1 To Len(DecimalPart)

          tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))

        Next

      End If

   End If

  '  Done!

   NumberAsText = NumberSign & tmp

End Function

Private Sub BuildArray(sNumberText() As String)

   ReDim sNumberText(0 To 27) As String

   sNumberText(0) = "Zero"

   sNumberText(1) = "One"

   sNumberText(2) = "Two"

   sNumberText(3) = "Three"

   sNumberText(4) = "Four"

   sNumberText(5) = "Five"

   sNumberText(6) = "Six"

   sNumberText(7) = "Seven"

   sNumberText(8) = "Eight"

   sNumberText(9) = "Nine"

   sNumberText(10) = "Ten"

   sNumberText(11) = "Eleven"

   sNumberText(12) = "Twelve"

   sNumberText(13) = "Thirteen"

   sNumberText(14) = "Fourteen"

   sNumberText(15) = "Fifteen"

   sNumberText(16) = "Sixteen"

   sNumberText(17) = "Seventeen"

   sNumberText(18) = "Eighteen"

   sNumberText(19) = "Nineteen"

   sNumberText(20) = "Twenty"

   sNumberText(21) = "Thirty"

   sNumberText(22) = "Forty"

   sNumberText(23) = "Fifty"

   sNumberText(24) = "Sixty"

   sNumberText(25) = "Seventy"

   sNumberText(26) = "Eighty"

   sNumberText(27) = "Ninety"

End Sub

Private Function IsBounded(vntArray As Variant) As Boolean

  '  Note: the application in the IDE will stop

  '  at this line when first run if the IDE error

  '  mode is not set to "Break on Unhandled Errors"

  '  (Tools/Options/General/Error Trapping)

   On Error Resume Next

   IsBounded = IsNumeric(UBound(vntArray))

End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _

                              Optional bUseAnd As Boolean) As String

   Dim CardinalNumber As Integer

   If TestValue > 99 Then

      CardinalNumber = TestValue \ 100

      HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "

      TestValue = TestValue - (CardinalNumber * 100)

   End If

   If bUseAnd = True Then

      HundredsTensUnits = HundredsTensUnits & "and "

   End If

   If TestValue > 20 Then

      CardinalNumber = TestValue \ 10

      HundredsTensUnits = HundredsTensUnits & _

                          sNumberText(CardinalNumber + 18) & " "

      TestValue = TestValue - (CardinalNumber * 10)

   End If

   If TestValue > 0 Then

      HundredsTensUnits = HundredsTensUnits & _

                          sNumberText(TestValue) & " "

   End If

End Function

See

http://support.microsoft.com/?kbid=213360

---

Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk

Perhaps this VBA function can help:

'*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*

'* NumsToWords(NumSource, MajorCurrency, MinorCurrency, MajorMinorLink) function                     *

'*                                                                                                   *

'* Where:Words                                                                                       *

'* NumSource:      Number, or cell reference containing the number, to be converted to words         *

'* MajorCurrency:  Primary currency name.......................... (Optional: Default is "Dollar")   *

'* MinorCurrency:  Secondary currency name........................ (Optional: Default is "Cent")     *

'* MajorMinorLink: Word to connect Major and Minor Currency....... (Optional: Default is "and")      *

'* SkipMinor:      True/False flag to ignore the MinorCurrency.... (Optional: Default is FALSE)      *

'*                                                                                                   *

'* Programmer:    Ron Coderre                                                                        *

'* Created on:    14-JUL-2007                                                                        *

'* Last Modified: 24-MAR-2009                                                                        *

'*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*

Public Function NumsToWords( _

   NumSource As Currency, _

   Optional MajorCurrency As String = "Dollar", _

   Optional MinorCurrency As String = "Cent", _

   Optional MajorMinorLink As String = "and", _

   Optional SkipMinor As Boolean = False _

   ) As String

Dim Words As String       ' Used to build the word phrase

Dim WIPnum As String      ' Orig number formatted as 000000000000000.00

Dim LU_NumList()          ' Array of numbers to match during the process

Dim LU_NumText()          ' Text values associated with LU_NumList values

Dim iMisc As Integer      ' Container for interim calculations

Dim iCtr As Integer       ' Counter variable

Dim LU_Denom()            ' Array of groups (Trillion, Billion, etc)

Dim DecSepChar            ' Decimal separator symbol ( eg English: . )

LU_NumList = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, _

                  11, 12, 13, 14, 15, 16, 17, 18, 19, _

                  20, 30, 40, 50, 60, 70, 80, 90)

LU_NumText = Array("", " One", " Two", " Three", " Four", " Five", _

   " Six", " Seven", " Eight", " Nine", " Ten", " Eleven", _

   " Twelve", " Thirteen", " Fourteen", " Fifteen", " Sixteen", _

   " Seventeen", " Eighteen", " Nineteen", " Twenty", " Thirty", _

   " Forty", " Fifty", " Sixty", " Seventy", " Eighty", " Ninety")

DecSepChar = Application.International(xlDecimalSeparator)

LU_Denom = Array(" Trillion", " Billion", " Million", " Thousand", "", "")

WIPnum = Replace(Format(Abs(NumSource), "000000000000000.00;KillFlow"), DecSepChar, "0")

'Pull successive WIPnum triads and assign word values

For iCtr = 0 To 5

   iMisc = CInt(Mid(WIPnum, (1 + iCtr * 3), 3))

   If Int(iMisc / 100) > 0 Then Words = Words & LU_NumText(Int(iMisc / 100)) & " Hundred"

   'Set the tens and ones phrase

   If (iMisc Mod 100) > 19 Then

      Words = Words & LU_NumText(Int((iMisc Mod 100) / 10) + 18) & LU_NumText(iMisc Mod 10)

   Else

      Words = Words & LU_NumText(iMisc Mod 100)

   End If

   If iMisc > 0 Then Words = Words & LU_Denom(iCtr)

   If iCtr = 4 Then  ' Finish building the whole nums phrase

      Words = Words & " " & MajorCurrency

      If Int(NumSource) = 0 Then Words = "No" & Words

      If Int(NumSource) <> 1 And MajorCurrency <> "" Then Words = Words & "s"

      If SkipMinor = False Then Words = Words & " " & MajorMinorLink Else Exit For

   ElseIf iCtr = 5 Then 'Complete the MinorCurrency phrase

      If SkipMinor = False Then

         If iMisc = 0 Then Words = Words & " No"

         Words = Words & " " & MinorCurrency

         If iMisc <> 1 And MinorCurrency <> "" Then Words = Words & "s"

      End If

   End If

Next iCtr

NumsToWords = Trim(Replace(Words, "  ", " "))

End Function

With A1: 1.23

Using default usage

B1: =NumsToWords(A1)

Returns: One Dollar and Twenty Three Cents

---

Ron Coderre

Microsoft MVP (2006 - 2010) - Excel

P.S. If any post answers your question, please mark it as the Answer (so it won't keep showing as an open item.)

Thansk everyone, I tried a few of the options and liked Ricks the most because of the options available for formatting the cents. Well thought out Rick, thanks again!