Amount to Words [EXCEL 2007]

**Rick Rothstein** · 06-07-2012, 02:04 PM

This is a modification to the code I posted here "Yet Another Number-To-Words Function (Sorry, US Style Only)" where I changed the dollars and cents to output as AED and fils with the word Only at the end and, of course, I changed the function name itself to AEDtext. I removed all the other options so there is only one argument to the function... the number you want to convert to text. Copy/paste the following code into a standard module and then use AEDtext as if it were an Excel worksheet function, meaning if you have a number in A1, you could put this in B1...

=AEDtext(A1)

The AEDtext function can also be called from your own VB code routines if you need to use it that way instead. Here is the code...

Code:

Private sNumberText() As String

Public Function AEDtext(NumberIn As Variant) 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
   Dim AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR As String
  '----------------------------------------
  '  Begin setting conditions for formatting
  '----------------------------------------
   sStyle = "dollar"
   bUseAnd = sStyle = "and"
   bUseDollars = sStyle = "dollar"
   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
  '----------------------------------------
   NumberIn = Trim$(NumberIn)
   If Not IsNumeric(NumberIn) Then
      AEDtext = "Error - Number improperly formed"
      Exit Function
   Else
      DecimalPoint = InStr(NumberIn, ".")
      If DecimalPoint > 0 Then
         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
         WholePart = Left$(NumberIn, DecimalPoint - 1)
      Else
         DecimalPoint = Len(NumberIn) + 1
         WholePart = NumberIn
      End If
      If InStr(NumberIn, ",,") Or _
         InStr(NumberIn, ",.") Or _
         InStr(NumberIn, ".,") Or _
         InStr(DecimalPart, ",") Then
         AEDtext = "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
                  AEDtext = "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
      AEDtext = "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
      AEDtext = "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)
      tmp = "AED " & tmp
      If Len(CentsString) > 0 Then
         tmp = tmp & "& " & CentsString
         tmp = tmp & "Fils Only"
      Else
        tmp = tmp & "Only"
      End If
   End If
  '  Done!
   AEDtext = 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
   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