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]

Thanks for the feedback.......Teamwork wins again !!!!!