Help on cleaning up code/formula

[julxl]

Dear all,

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)

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)

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)

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

 

[NateO]

NumToText() is definitely expensive...

While it's not volatile, you might want to consider pasting the return for any given cell as a value, once complete.

How you would do this in Access? Perhaps as a query, but you'd probably throttle your processor there as well...

 

[Anthony47]

Hi julxl,
so basically every new invoice creates a new sheet in your workbook, end each of the sheets has full edit capabilities?
This will results in bigger and bigger file, ie going from bad to worse…

Also, does the workbook link to other workbook?

Anyway I would try setting the Calculation to Manual:
-Menu ->Tools ->Options; select Calculation tab and set Manual and remove Calcolate on closing;
-select the latest sheet, the one that will be duplicated on next invoice, right-click on its name tab, select “Show code”;
-this will open the vba editor; copy the following macros in the right frame, now possibly blank:

Private Sub Worksheet_Activate()
    ActiveSheet.Calculate
End Sub

Private Sub Worksheet_Deactivate()
    ActiveSheet.Calculate
End Sub

-Repeat this step with the Summary sheet

PLEASE NOTE that if your worksheets (Standard and Summary) already have any Worksheet_Activate or Worksheet_Deactivate macro, the above macros must not be copied, but you have to evaluate adding the statement ActiveSheet.Calculate at the beginning of the existing macros.

Add this macro to one of your Modules and assign to it a shortcut (for example <Contr><Uppercase>k)

Sub WsCalc()
    Calculate      ’Calculate current worksheet
End Sub

Use this macro instead of F9 to command “Calculate now”, as F9 will recalculate the entire workbook wereas this macro will recalculate only the current worksheet.

In this way, Calculation will not occour on workbook opening, but only manually and when a worksheet is activated or deactivated; I don’t know the effect of this in opening and closing the file, but it should improve.

ALSO, you save previous invoice as living sheets; it would be better to save them as frozen values.

You might also consider (1) saving each invoice as a separate workbook, or (2)keeping only the variable data of the invoice as a list of data and only save the “model” for creating and printing new invoices and display an reprint old ones (but this second approach depends on the complexity of the items you normally invoice).

Hope this can be useful to you.

Bye,

 

[julxl]

While it's not volatile, you might want to consider pasting the return for any given cell as a value, once complete.

i am not sure what are you trying to say here but to my understanding ,basically you suggest me to INDIRECT the value of each invoice to a value in summary sheet? i am not sure how to do that.

Sub WsCalc()
Calculate ’Calculate current worksheet
End Sub

i will try that,thank you

ALSO, you save previous invoice as living sheets; it would be better to save them as frozen values.

,could you enlighten me on this?its a cool idea because i will not need to change anything on previous invoice once completed,it will remained forever as a record.

You might also consider (1) saving each invoice as a separate workbook, or (2)keeping only the variable data of the invoice as a list of data and only save the “model” for creating and printing new invoices and display an reprint old ones (but this second approach depends on the complexity of the items you normally invoice).

1) is totally out,because it just too dauting to open each invoice in different workbook which in term defeat the purpose of summary page.While it can reduce file size,but it loses its 'all in 1' functionality .If i were to keep a summary page, the only way i see achievable is through link which is what i am trying to avoid (no link to other workbook at the moment).

2)my level of understanding still could not let me comprehend this

so basically every new invoice creates a new sheet in your workbook, end each of the sheets has full edit capabilities?

yes,the file grows bigger and bigger and excel need to calculate more & more sheets when save/open as days gone by..........

sorry for the unorganised order of the answer, thank you for taking time to help me.



julxl

 

[DominicB]

Good morning julxl

(2)keeping only the variable data of the invoice as a list of data and only save the “model” for creating and printing new invoices and display an reprint old ones (but this second approach depends on the complexity of the items you normally invoice).

What Anthony47 is suggesting is that you have, say 1 live invoice sheet and one dummy invoice sheet. The user enters the data into the live invoices and presses a button which prints the inoice twice and clears this sheet. The data that has been cleared from the sheet is transferred to a third sheet where invoice number 10001 is stored in row 1, invoice 10002 in row 2 etc. Column A is Invoice No., B is Invoice Date, C is Order No, D is Due By Date etc.

If you need to see this invoice again or reprint it you go to the dummy sheet, put the invoice number in and VLOOKUP formulae in all the other fields will populate the sheet.

This would be the most efficient way to keep all the data rather than individual invoices. Although the third data sheet won't make much sense to a user in its raw form this is irrelevamt because the invoice can be recreated at any time.

HTH

DominicB

 

[julxl]

thank you DominicB,

ic ,i will look into it.It will take me some time to experiment with the code/formulas.

rgds,

julxl

 

[DominicB]

Hi julxl

I have a workbook that works in a similar way to this that I developed for the company I work for. If you want to have a look at it to see how I have done it then feel free to e-mail or PM me to let me know.

Unfortunately, there is no documentation for it but it should be easy enough to follow.

HTH

DominicB
dominic@dom-and-lis.co.uk

 

[julxl]

i have sent you a PM