slow response time calculating

shodan

Active Member
Joined
Jul 6, 2005
Messages
481
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?
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
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.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,061
Office Version
  1. 365
Platform
  1. Windows
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
 

shodan

Active Member
Joined
Jul 6, 2005
Messages
481
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.
 

shodan

Active Member
Joined
Jul 6, 2005
Messages
481

ADVERTISEMENT

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
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,061
Office Version
  1. 365
Platform
  1. Windows
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
 

shodan

Active Member
Joined
Jul 6, 2005
Messages
481

ADVERTISEMENT

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.
 

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
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
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,061
Office Version
  1. 365
Platform
  1. Windows
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?
 

shodan

Active Member
Joined
Jul 6, 2005
Messages
481
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,118,799
Messages
5,574,380
Members
412,589
Latest member
ArtBOM
Top