slow response time calculating

shodan

Active Member
Joined
Jul 6, 2005
Messages
486
Hi guys,

After some help from all of you on the board, I was able to set up a database using quit a lot of functions, and one small macro to be carried out. Now, this macro is quit slow to be carried out. please see the code i have:

Code:
Sub Print_All_Items()
Dim itemrange As Range
Dim itemcounter As Integer
Dim volumeversie As String

Range("D2").Value = "Your request is now processing.  Please wait...."
Range("D2").Select
With Selection.Font
.ColorIndex = 5
.Size = 12
End With
Range("A1").Select
Application.ScreenUpdating = False

volumeversie = Worksheets("MRP").Range("D8").Value

'toevoegen en opmaak pagina
Worksheets("VOLUMES").Activate
Worksheets("VOLUMES").Range("ITEMS").Select
Selection.Copy
Worksheets.Add
With ActiveSheet
.Paste
.Name = "Printout"
End With

With ActiveSheet.PageSetup
.CenterHeader = "&""Tahoma,Vet""&14Overview " & volumeversie
.LeftFooter = "Created by J.Meynen"
.RightFooter = "&D &T "
End With

Set itemrange = Range("A1").CurrentRegion
itemcounter = itemrange.Rows.Count

'plaatsen van de formula
Range("C1").Select
For i = 1 To itemcounter
Cells(i, 3).FormulaArray = "=SUM(IF(DATABASE!$E$4:$AJ$10000=Printout!A" & i & ",(DATABASE!$C$4:$C$10000)*(DATABASE!$F$4:$AJ$10000)))" ' this formula is to be replaced by the large sumif formula
Next i

'copy/paste formulas to values and remove zero lines

Worksheets("Printout").Activate
Range(Cells(1, 1), Cells(itemcounter, 3)).Select
With Selection
.Copy
.Range("A1").PasteSpecial xlPasteValues
.Application.CutCopyMode = False
.Sort Key1:=Range("C1"), Order1:=xlDescending
End With

Range(Cells(1, 3), Cells(itemcounter, 3)).NumberFormat = "#,##0"

'Delete de lege rijen
For i = itemcounter To 1 Step -1 'itemcounter
If Cells(i, 3).Value = 0 Then Rows(i).Delete
Next i

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False
Worksheets("Printout").Delete
Worksheets("MRP").Activate
MsgBox "Your request has been processed.  Please get your copy at the printer"

Range("D2").ClearContents

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

Now , the formula I let the procedure enter takes some time I guess:

Code:
=SUM(IF(DATABASE!$E$4:$AJ$10000=MRP!D19;(DATABASE!$C$4:$C$10000)*(DATABASE!$F$4:$AJ$10000)))

the last part of this formula "DATABASE!$F$4:$AJ$10000" are volumes in a table that are lookuped with following formula:

Code:
=SUMPRODUCT(--(VOLUMES!$A$1:$A$10000=DATABASE!A4);--(VOLUMES!$B$1:$B$10000=DATABASE!B4);(VOLUMES!$C$1:$C$10000))

the runtime of the macro becomes worse when I want this last formula to be flexible, using an indirect vlookup like this:

Code:
=SUMPRODUCT(--(VOLUMES!$A$11:$A$10000=DATABASE!A4);--(VOLUMES!$B$11:$B$10000=DATABASE!B4);INDIRECT(VLOOKUP(Sheet4!$D$9;VOLUMES!$A$1:$B$2;2;FALSE)))


In plain excell, everything works fine, but of course that is just calculated for one cell, but using the macro combined with the most flexible formulas, the response time is verry bad.

Even if I do save as "new name" it start calculating and it takes a whole lot of time for the sheet to be saved with a new name again. When I want a new version of the file I have to use the explorer and copy and rename it there. The file is only about 3mega.

Does anyone see things about my code that are bad (i'm very new in vba)
or ways for improvement?
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Well you can spare yourself SOME time by turning off calculation while the formulas are being plugged in, and then turn it back on at the end. The way you have it set up, it's going to autocalculate everytime you ad a formula.
 
Upvote 0
Is this anny better?
Code:
Sub Print_All_Items()
Dim itemrange As Range
Dim itemcounter As Integer
Dim volumeversie As String

    With Range("D2")
        .Value = "Your request is now processing.  Please wait...."
        With .Font
            .ColorIndex = 5
            .Size = 12
        End With
    End With
    
    Application.ScreenUpdating = False
    
    volumeversie = Worksheets("MRP").Range("D8").Value
    
    'toevoegen en opmaak pagina
    Worksheets("VOLUMES").Range("ITEMS").Copy
    
    Worksheets.Add
    
    With ActiveSheet
        .Paste
        .Name = "Printout"
    End With
    
    With ActiveSheet.PageSetup
        .CenterHeader = "&""Tahoma,Vet""&14Overview " & volumeversie
        .LeftFooter = "Created by J.Meynen"
        .RightFooter = "&D &T "
    End With
    
    Set itemrange = Range("A1").CurrentRegion
    itemcounter = itemrange.Rows.Count
    
    'plaatsen van de formula
    
    For i = 1 To itemcounter
        Cells(i, 3).FormulaArray = "=SUM(IF(DATABASE!$E$4:$AJ$10000=Printout!A" & i & ",(DATABASE!$C$4:$C$10000)*(DATABASE!$F$4:$AJ$10000)))" ' this formula is to be replaced by the large sumif formula
    Next i
    
    'copy/paste formulas to values and remove zero lines
    
    Worksheets("Printout").Range(Cells(1, 1), Cells(itemcounter, 3)).Copy
    
    With Worksheets("Printout")
        .Range("A1").PasteSpecial xlPasteValues
        .Application.CutCopyMode = False
        .Sort Key1:=Range("C1"), Order1:=xlDescending
    End With
    
    Range(Cells(1, 3), Cells(itemcounter, 3)).NumberFormat = "#,##0"
    
    'Delete de lege rijen
    For i = itemcounter To 1 Step -1 'itemcounter
        If Cells(i, 3).Value = 0 Then Rows(i).Delete
    Next i
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
    Application.DisplayAlerts = False
    Worksheets("Printout").Delete
    Worksheets("MRP").Activate
    MsgBox "Your request has been processed.  Please get your copy at the printer"
    
    Range("D2").ClearContents
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
ok, gonna try out both suggestions. where in the code should I best turn of the calculations and when to turn them back on? Haven't done that before.

Thanks.
 
Upvote 0
Norie,

Got an error on your procedure somewhere arround the paste values. so I used mine again and inserted the manual calculation thing. I also included a timer, and the strange thing is that with the calculation set to manual it runs 50sec in stead of 27 without that adjustment. probabably i inserted it wrong in the code. Can you have a look please?

Code:
Sub Print_All_Items()
Dim itemrange As Range
Dim itemcounter As Integer
Dim volumeversie As String
Dim starttijd, eindtijd As Date

starttijd = Timer

Range("D2").Value = "Your request is now processing.  Please wait...."
Range("D2").Select
With Selection.Font
.ColorIndex = 5
.Size = 12
End With
Range("A1").Select
Application.ScreenUpdating = False

volumeversie = Worksheets("MRP").Range("D8").Value

'toevoegen en opmaak pagina
Worksheets("VOLUMES").Activate
Worksheets("VOLUMES").Range("ITEMS").Select
Selection.Copy
Worksheets.Add
With ActiveSheet
.Paste
.Name = "Printout"
End With

With ActiveSheet.PageSetup
.CenterHeader = "&""Tahoma,Vet""&14Overview " & volumeversie
.LeftFooter = "Created by J.Meynen"
.RightFooter = "&D &T "
End With

Set itemrange = Range("A1").CurrentRegion
itemcounter = itemrange.Rows.Count

'Application.Calculation = xlCalculationManual

'plaatsen van de formula
Range("C1").Select
For i = 1 To itemcounter
Cells(i, 3).FormulaArray = "=SUM(IF(DATABASE!$E$4:$AJ$10000=Printout!A" & i & ",(DATABASE!$C$4:$C$10000)*(DATABASE!$F$4:$AJ$10000)))" ' this formula is to be replaced by the large sumif formula
Next i

'Application.Calculate
'Application.Calculation = xlCalculationAutomatic
'copy/paste formulas to values and remove zero lines

Worksheets("Printout").Activate
Range(Cells(1, 1), Cells(itemcounter, 3)).Select
With Selection
.Copy
.Range("A1").PasteSpecial xlPasteValues
.Application.CutCopyMode = False
.Sort Key1:=Range("C1"), Order1:=xlDescending
End With

Range(Cells(1, 3), Cells(itemcounter, 3)).NumberFormat = "#,##0"

'Delete de lege rijen
For i = itemcounter To 1 Step -1 'itemcounter
If Cells(i, 3).Value = 0 Then Rows(i).Delete
Next i

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False
Worksheets("Printout").Delete
Worksheets("MRP").Activate
MsgBox "Your request has been processed.  Please get your copy at the printer"

Range("D2").ClearContents

Application.DisplayAlerts = True
Application.ScreenUpdating = True
eindtijd = Timer

'MsgBox Format(eindtijd - starttijd, "0.0")


End Sub
 
Upvote 0
What error did you get with my code?

By the way I don't think you actually want to turn off calculation.

If you do your formula won't get calculated
 
Upvote 0
a runtime 438.

I thought to try like oorang mentioned and put the calculations of, and back on when all formulas are entered and only than calculate.
 
Upvote 0
Correct :)
Just put this at the top of your code:
Code:
Application.Calculation = xlManual
And this when you are ready for it to calculate again:
Code:
Application.Calculation = xlAutomatic
Calculate
 
Upvote 0
shodan

Have you considered that the problem might actually be with the formula?

What is the formula actually supposed to do?

Have you considered using a SUMPRODUCT formula which wouldn't need to be an array formula?
 
Upvote 0
Norie,

I use us a sumproduct formula, (see my first example). but when i make it variable, using an indirect vlookup to determin the range to be summed, it is than the the macro runs slow.

Oorang, I tried this with the calculation statement, (see code) but It ran longer? is that possible?
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top