i have an excel invoicing workbook for a small business and it runs slow on open/save ever since the transaction has grown to more than 300 pages.Here is what i have:

Code1 (NumToText)

Code:

```
Option Explicit
Option Base 1 ' the functions will not work properly if this is omitted
Function NumToText(Number As Double, ShowCurrency As Boolean) As String
Dim Ipart As Double, Dpart As Long, NegValue As Boolean, sNumber As String
Dim cdGroups As Integer, dGroups() As String, dgValue() As Integer, nLen As Integer, i As Integer
Application.Volatile
NumToText = "null" '*** add description for zero values
If Abs(Number) < 0.001 Then
If ShowCurrency Then NumToText = NumToText & " Dirhams" '*** add currency description
Exit Function
End If
If Number < 0 Then NegValue = True Else NegValue = False
Ipart = Fix(Abs(Number)) ' Integer part of Number
Dpart = (Abs(Number) - Ipart) * 100 ' Decimal part of Number
Ipart = Abs(Ipart) ' remove minus sign
' code for the integer part of Number
nLen = Len(Format(Ipart, "0")) ' number of digits in Ipart
While nLen Mod 3 <> 0
nLen = nLen + 1
Wend
cdGroups = nLen / 3 ' number of digit groups
ReDim dGroups(cdGroups) ' declare variable
ReDim dgValue(cdGroups) ' declare variable
sNumber = ""
For i = 1 To nLen
sNumber = sNumber & "0" ' create required number format
Next i
sNumber = Format(Ipart, sNumber) ' apply number format
For i = 1 To cdGroups
dGroups(i) = Mid(sNumber, (i * 3 - 2), 3) ' remember group digits
dgValue(i) = CInt(dGroups(i)) ' remember group value
Next i
' convert each digit group to text
For i = 1 To cdGroups
dGroups(i) = Text100(CLng(dGroups(i)), cdGroups - i + 1, cdGroups)
Next i
' create output string
NumToText = ""
For i = 1 To cdGroups
NumToText = NumToText & dGroups(i) & " "
Next i
If ShowCurrency Then ' add currency description
If dgValue(cdGroups) = 1 Then
NumToText = " Dirham" & NumToText '*** currency description for 1 unit
Else
NumToText = " Dirhams" & NumToText '*** currency description for other units
End If
End If
' code for the decimal part of Number
If Dpart > 0 Then
NumToText = Trim(NumToText)
If ShowCurrency Then
NumToText = NumToText & " and fils " '*** add "AND" or "COMMA" to the description
Else
NumToText = NumToText & " point " '*** add "COMMA" or "AND" to the description
End If
NumToText = NumToText & Text100(CLng(Dpart), 1, 1) '*** convert numbers to text
'If ShowCurrency Then NumToText = NumToText & " fils" '*** add currency description for decimal part
End If
Erase dGroups ' clear array variable
Erase dgValue ' clear array variable
If NegValue Then NumToText = "minus " & NumToText '*** add negative label if required
End Function
Function Text100(Number As Long, dGroup As Integer, cGroups As Integer) As String
' returns the text description for Number
' Number : must be a value >0 and <1000
' dGroup : the digit group for which Number belongs.
' cGroups : count of digit groups in the original number.
Dim hPart As Integer, tPart As Integer, oPart As Integer, tText As String
Dim NumberNames1 As Variant, NumberNames2 As Variant
Text100 = ""
If Number >= 1000 Or Number < 1 Then Exit Function
hPart = CInt(Left((Format(Abs(Number), "000")), 1)) ' count of hundreds in Number
tPart = CInt(Right((Format(Abs(Number), "000")), 2)) ' value less than 100 in Number
tText = ""
If tPart > 0 And tPart <= 19 Then
If Number = 1 Then
Select Case cGroups
Case 1: tText = Text20(tPart, 1) ' get textdescription for <1 000
Case 2: tText = Text20(tPart, 2) ' get textdescription for <1000 000
Case Else: tText = Text20(tPart, 1) ' get textdescription for other values
End Select
Else
tText = Text20(tPart, 1) ' get text description
End If
End If
If tPart > 19 Then
oPart = tPart Mod 10 ' value less than 10 in Number
tText = Text10(CInt(Left((Format(tPart, "00")), 1))) & Text20(oPart, 1) ' get text description
End If
If hPart > 0 And tPart > 0 Then tText = " " & tText '*** add "AND" to the description
If hPart = 0 And dGroup < cGroups Then tText = " " & tText '*** add "AND" to the description
If hPart > 0 Then
tText = Text20(hPart, 2) & " hundred" & tText '*** add "HUNDREDS" to the description
End If
' add number description for thousand, million, billion, trillion, quadrillion, quintillion, sextillion and septillion in the next two array variables
NumberNames1 = Array(" thousand", " million", " milliard", " trillion", "quadrillion", " quintillion", " sekstillion", " septillion") '*** description for 1 unit
NumberNames2 = Array(" thousand", " million", "milliard", " trillion", " quadrillion", " quintillion", " sekstillions", " septillion") '*** description for more than 1 unit
oPart = dGroup - 1 ' calculate index number for digit group description
If oPart > 0 And oPart <= UBound(NumberNames1) Then
If Number = 1 Then
tText = tText & NumberNames1(oPart) ' add digit group description
Else
tText = tText & NumberNames2(oPart) ' add digit group description
End If
End If
Text100 = tText ' apply function result
Erase NumberNames1 ' clear array variable
Erase NumberNames2 ' clear array variable
End Function
Function Text20(Number As Integer, Optional nAlt As Variant) As String
' returns the text description for Number
' Number : must be a value >0 and <20
' nAlt : alternative text description for the value 1 in different positions.
' *** all 19 string descriptions in this function can be changed for internationalisation purposes
Dim t As String
t = ""
Select Case Number
Case 1:
If nAlt = 2 Then
t = " one" ' description for first position in digit group
Else
t = " one" ' description for other positions in digit group
End If
Case 2: t = " two"
Case 3: t = " three"
Case 4: t = " four"
Case 5: t = " five"
Case 6: t = " six"
Case 7: t = " seven"
Case 8: t = " eight"
Case 9: t = " nine"
Case 10: t = " ten"
Case 11: t = " eleven"
Case 12: t = " twelve"
Case 13: t = " thirteen"
Case 14: t = " fourteen"
Case 15: t = " fifteen"
Case 16: t = " sixteen"
Case 17: t = " seventeen"
Case 18: t = " eighteen"
Case 19: t = " nineteen"
End Select
Text20 = t ' apply function result
End Function
Function Text10(Number As Integer) As String
' returns the text description for Number * 10
' *** all 10 string descriptions in this function can be changed for internationalisation purposes
Dim t As String
t = ""
Select Case Number
Case 1: t = " ten"
Case 2: t = " twenty"
Case 3: t = " thirty"
Case 4: t = " forty"
Case 5: t = " fifty"
Case 6: t = " sixty"
Case 7: t = " seventy"
Case 8: t = " eighty"
Case 9: t = " ninty"
End Select
Text10 = t
End Function
```

code2 (PrintInvoice)

Code:

```
Sub PrintInvoice2()
For Each ws In ActiveWindow.SelectedSheets
With ws
.PageSetup.RightFooter = "Customer "
.PrintOut
.PageSetup.RightFooter = " Sales "
.PrintOut
.PageSetup.RightFooter = " Account"
.PrintOut
End With
Next ws
End Sub
```

Code3 (NewInvoice)

Code:

```
Sub NewInvoice()
Dim i%
i = Sheets.Count
ActiveSheet.Copy After:=Sheets(i)
ActiveSheet.Name = "A" & Format(Right(Sheets(i).Name, 4) + 1, "000#")
End Sub
```

And a 1st page on the workbook as a Summary page which lists out all the invoice pages,with INDIRECT and HYPERLINK function.

I wonder which one of the above code actually slows the workbook down.If any one spot anything,please let me know.Perhaps ms access is a better way? which i have very limited experience on.

thank you for your time.

julxl