Loops taking too long - advice please...

[Steeviee]

Hello Gang,

Here is my problem. I run a report from a template each week for the purcahsing dept. They have a comments field and have asked if I caould transfer the comments from the previous week's report into current.

I have about 3,500 lines and this changes each week. When I choose "D" (see code below) it all runs in a few seconds as there are only about 30 lines in that category. However, when I choose "N", which has >1000 lines, I have to give up after about 5 minutes.

i am looking for advice on how to speed up the code. I'm sure that I'm being naive about how I've created this macro.

Sub tttt()
Application.Calculation = xlCalculationManual
Range("BJ12").Formula = "=TRUNC(((TODAY()-DATE(YEAR(TODAY()),1,0))+6)/7)"
archive = Range("BJ12").Value - 1
y = InputBox("Please Enter W, N, C U or D")
MyCnt = Evaluate(Application.Count(Range("A13:A10000")))
x = 13
Do Until x = MyCnt + 1
If y = "W" Then
    If Range("AO" & x).Value = "Water" And Range("BD" & x).Value > 0 Then
    Range("BL" & x).Formula = "=VLOOKUP(BJ" & x & ",'G:Archive reports\[Supply Chain Report wk" & archive & ".XLS]PO'!$BJ:$BL,3,FALSE)"
    End If
ElseIf y = "N" Then
    If Range("AO" & x).Value = "Nu" And Range("BD" & x).Value > 0 Then
    Range("BL" & x).Formula = "=VLOOKUP(BJ" & x & ",'G:\Archive reports\[Supply Chain Report wk" & archive & ".XLS]PO'!$BJ:$BL,3,FALSE)"
    End If
ElseIf y = "C" Then
    If Range("AO" & x).Value = "Con" And Range("BD" & x).Value > 0 Then
    Range("BL" & x).Formula = "=VLOOKUP(BJ" & x & ",'G:\Archive reports\[Supply Chain Report wk" & archive & ".XLS]PO'!$BJ:$BL,3,FALSE)"
    End If
ElseIf y = "D" Then
    If Range("AO" & x).Value = "Downs" And Range("BD" & x).Value > 0 Then
    Range("BL" & x).Formula = "=VLOOKUP(BJ" & x & ",'G:\Archive reports\[Supply Chain Report wk" & archive & ".XLS]PO'!$BJ:$BL,3,FALSE)"
    End If
ElseIf y = "U" Then
    If Range("AO" & x).Value = "Ups" And Range("BD" & x).Value > 0 Then
    Range("BL" & x).Formula = "=VLOOKUP(BJ" & x & ",'G:\Archive reports\[Supply Chain Report wk" & archive & ".XLS]PO'!$BJ:$BL,3,FALSE)"
    End If
Else
MsgBox "You have not entered W, D, U, C or N - Please try again"
Exit Sub
End If
x = x + 1
Loop
Application.Calculation = xlCalculationAutomatic
End Sub

As always, many thanks in advance for your suggestions.

 

[Michael M]

Try adding

application.screenupdating=false ' at the beginning
AND
application.screenupdating=true ' at the end

 

[njimack]

Hard to give a definitive answer without seeing the actual file, but the delay is probably because each cell that you write the formula to is accessing another file. Try having that file open and amending the code to remove the full path - I would expect that to be much quicker.

Also, your VLOOKUP formula is referring to entire ranges, i.e 65,000 rows (or 1million in Excel 2007 or 2010). Either consider using dynamic ranges, or figure out the maximum number of rows your dataset is likely to be.

Also, at the same point you set calculation to manual, I would set ScreenUpdating to False - this can bring an immediate improvement, as well as removing the annoying screen flicker. Just remember to set it back to true at the end of your code.

Finally, writing a formula to an entire range can often be quicker than to individual cells. You would of course have to amend your formula, to test the values in columns AO and BD.

 

[Steeviee]

Thanks both. I hadn't bothered with ScreenUpdating as there is no navigation away from the current sheet but I'll give it a go.

Excellent suggestion ref opening the other file - never thought of that.

Njimack, please could you explain a little more about writing the formula to the entire range? Would I do this with RC type?

I have this in another part of the code:

Range("BD13").FormulaR1C1 = "=VLOOKUP(RC[-1],IF(RC[-2]=""B"",Barr,IF(RC[-2]=""R"",Rarr,IF(RC[-2]=""A"",Aarr))),18,FALSE)"

(admittedly, i recorded this!) which refers to named ranges. Is this the kind of thing I could use? I have a total of 9 columns of formulas to refer to all the data and so maybe I could leaarn something and speed up the whole thing.

Thanks again to you both for taking the time. Much obliged.

 

[Michael M]

Navigation away from the current sheet has nothing to do with screenupdating.
As an example:
If you had to delete rows in the current sheet for 65000 rows it would update after each row, which would take awhile.
by turning off screenupdating, nothing would happen until all of the rows were deleted

a rough example,I know, but I hope that helps explain it a little better!!

 

[njimack]

Writing to an entire range would require some tweaks to your overall code but will probably save a lot of time. Below is an example of how I would structure it. You could go further and replace the InputBox with a userform containing a ComboBox - this would restrict the user to selecting a value from a pre-determined list.

Regarding dynamic ranges - take a look at http://contextures.com/xlNames01.html#Dynamic

Sub tttt()
Dim archive
Dim MyCnt As Long
Dim y As String
Dim x As Integer

Range("BJ12").Formula = "=TRUNC(((TODAY()-DATE(YEAR(TODAY()),1,0))+6)/7)"

archive = Range("BJ12").Value - 1
y = InputBox("Please Enter W, N, C U or D")

If y <> "W" And y <> "N" And y <> "C" Then 'continue for other letters
    MsgBox "You have not entered W, D, U, C or N - Please try again"
    Exit Sub
End If

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

x = 13
MyCnt = Range("A" & Rows.Count).End(xlUp).Row


Select Case y

    Case "W": Range(Cells(13, 64), Cells(MyCnt, 64)).Formula = "IF(AND(AO13=""Water"",BD13=0),VLOOKUP.....)"
    
    Case "N": 'etc
    
    Case "C": 'etc

End Select

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

 

[Steeviee]

Cool. Thanks Michael - I'd used to stop flickering when moving about but now I know better. Cheers.

 

[Steeviee]

Neil,

This so elegant - I'm very impressed. This looks much better than looping through the cells.

Thank you so much - I'm definitely going to try this & I'll review the link.

Cheers.

 

[njimack]

No problem, thanks for the feedback.

 

[Steeviee]

Final Update:

Combining ScreenUpdating off, opening the reference workbook and completing the range of formulas, the whole process now takes seconds rather than 15mins.

Please have a good weekend - job well done. You both deserve a beer.