Running a VBA in all excel files

**msiyab** · 12-26-2012, 12:34 PM

Dear All,

The following VB code (amount to words conversion) was given by Rick very long back. Its been really helpful to me. However, it only works on one excel. If at all i need to make it work on a new excel file, i need to paste the code and do all the procedures all over again to get the formula running.

Could someone show a shortcut or anything on how i can save this formula, so that whenever i open a new excel file, the formula is already available. As i am a newbie to Excel i would require detailed explanation.

FYI, I use Win XP, MS Office 2007.

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(Trim(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
      If Right(HundredsTensUnits, 1) <> " " Then HundredsTensUnits = HundredsTensUnits & "-"
      HundredsTensUnits = HundredsTensUnits & sNumberText(TestValue) & " "
   Else
      HundredsTensUnits = HundredsTensUnits & " "
   End If
   If Left(HundredsTensUnits, 1) = "-" Then HundredsTensUnits = Mid(HundredsTensUnits, 2)
End Function

**Rick Rothstein** · 12-26-2012, 12:56 PM

Originally Posted by msiyab

The following VB code (amount to words conversion) was given by Rick very long back. Its been really helpful to me. However, it only works on one excel. If at all i need to make it work on a new excel file, i need to paste the code and do all the procedures all over again to get the formula running.

Could someone show a shortcut or anything on how i can save this formula, so that whenever i open a new excel file, the formula is already available. As i am a newbie to Excel i would require detailed explanation.

Start a new workbook, copy/paste the code into it, then save the workbook using "Excel Macro-Enabled template" as the "Save as type" (use the directory that Excel defaults to, but give the workbook a name you will recognize as having this code in it). That's it... the next time you start a new Excel file that needs this functionality, click New, in the template list that appears, click on "My templates..." and choose the file with the name you just save the above under.

**msiyab** · 12-26-2012, 01:13 PM

(use the directory that Excel defaults to, ......

Could you please elaborate on this part? I did not get this part.

**Rick Rothstein** · 12-26-2012, 01:35 PM

Originally Posted by msiyab

Could you please elaborate on this part? I did not get this part.

When the Save As dialog appears, it will be defaulted to Excel's template directory... do NOT select a different directory... use the directory the Excel defaulted to.