Do Loop running slow

[pincivma]

Hi there

I did a very simple Do Loop macro. Below is the code:

Sub reinstatesformulas()

Application.ScreenUpdating = False
Range("AA106").Select
Do
ActiveCell.Select
If ActiveCell = "No Entry" Then
ActiveCell.Offset(0, -23).Select
ActiveCell.FormulaR1C1 = "=IF(R2C1=TRUE,RC[6],0)"
ActiveCell.Offset(0, 23).Select
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = "."
End Sub

This code takes 1 and 1/2 minutes to run since it has to go through 14,000 rows until it hits the end. Is there a better macro that can make this code run faster?

 

[My Aswer Is This]

What is your ultimate goal here?

Your trying to do what?

Do not say run this script.

Tell me in words what your wanting to accomplish

 

[Eric W]

Try this on a copy of your workbook:

Sub testit()
Dim i As Long, MyData As Variant, OldVal As Variant

    Application.ScreenUpdating = False
    OldVal = Application.Calculation
    Application.Calculation = xlManual
    MyData = Range("AA1:AA" & Cells(Rows.Count, "AA").End(xlUp).Row)
    
    For r = 106 To UBound(MyData)
        If MyData(r, 1) = "." Then Exit Sub
        If MyData(r, 1) = "No Entry" Then Cells(r, "D").FormulaR1C1 = "=IF(R2C1=TRUE,RC[6],0)"
    Next r
    Application.ScreenUpdating = True
    Application.Calculation = OldVal
    
End Sub

 

[Michael M]

It looks like this is what you want to achieve

Sub MM1()
Dim lr As Long, r as long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AA").End(xlUp).Row
For r = 106 To lr
   If Range("AA" & r) = "No Entry" Then
     Range("D" & r).Formula = "=IF($A$2=TRUE,J" & r & ",0)"
   End If
Next r
End Sub

But if you are simply reinstating formulas, you could also try

Sub MM2()
Range("D106:D" & Cells(Rows.Count, "AA").End(xlUp).Row).Formula = "=IF($A$2=TRUE,J106,0)"
End Sub

 

[pincivma]

What is your ultimate goal here?

Your trying to do what?

Do not say run this script.

Tell me in words what your wanting to accomplish

I have formulas in column D that are interspersed throughout all the way down to row 14,000. They are "If" formulas. I don't trust people using the excel workbook in case they delete them. I don't want to protect those cells either since some users might want to change some of the formulas to suit their purpose. But I do want the original formulas there when I run the macro for my purpose. So what I have done is created a macro that looks for an identifier, in this case it is "No Entry" in column AA. The I go back to column D (ActiveCell.Offset(0, -23).Select) and put in the formula ActiveCell.FormulaR1C1 = "=IF(R2C1=TRUE,RC[6],0)". Then I go back to column AA (ActiveCell.Offset(0, 23).Select) and do a loop that copies this formula in the D column where the AA column has the words "No Entry". The Do Loop copies this formula all the way down to Row 14,000. Obviously, the formulas change as they get copied down the row. I hope that this makes sense.

 

[My Aswer Is This]

Thanks for that explanation. Normally it is not a good practice to use select and active cell. I do see two other Posters are providing you with answers so I will just watch and see if what they provide works for you.

I have formulas in column D that are interspersed throughout all the way down to row 14,000. They are "If" formulas. I don't trust people using the excel workbook in case they delete them. I don't want to protect those cells either since some users might want to change some of the formulas to suit their purpose. But I do want the original formulas there when I run the macro for my purpose. So what I have done is created a macro that looks for an identifier, in this case it is "No Entry" in column AA. The I go back to column D (ActiveCell.Offset(0, -23).Select) and put in the formula ActiveCell.FormulaR1C1 = "=IF(R2C1=TRUE,RC[6],0)". Then I go back to column AA (ActiveCell.Offset(0, 23).Select) and do a loop that copies this formula in the D column where the AA column has the words "No Entry". The Do Loop copies this formula all the way down to Row 14,000. Obviously, the formulas change as they get copied down the row. I hope that this makes sense.

 

[pincivma]

It looks like this is what you want to achieve

Sub MM1()
Dim lr As Long, r as long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AA").End(xlUp).Row
For r = 106 To lr
   If Range("AA" & r) = "No Entry" Then
     Range("D" & r).Formula = "=IF($A$2=TRUE,J" & r & ",0)"
   End If
Next r
End Sub

But if you are simply reinstating formulas, you could also try

Sub MM2()
Range("D106:D" & Cells(Rows.Count, "AA").End(xlUp).Row).Formula = "=IF($A$2=TRUE,J106,0)"
End Sub

But this code puts the formula in every cell in column AA not only in those cells that have the "No Entry" as identifiers . So I will see if the Sub MM1() does the trick

 

[Fluff]

Another option

Sub pincivma()
   With Range("AA106", Range("AA" & Rows.Count).End(xlUp))
      .Replace "No Entry", "=XXXNo Entry", xlWhole, , False, , False, False
      .SpecialCells(xlFormulas, xlErrors).Offset(, -23).FormulaR1C1 = "=if(r2c1=true,rc[6],0)"
      .Replace "=XXXNo Entry", "No Entry", xlWhole, , False, , False, False
   End With
End Sub

 

[pincivma]

Another option

Sub pincivma()
   With Range("AA106", Range("AA" & Rows.Count).End(xlUp))
      .Replace "No Entry", "=XXXNo Entry", xlWhole, , False, , False, False
      .SpecialCells(xlFormulas, xlErrors).Offset(, -23).FormulaR1C1 = "=if(r2c1=true,rc[6],0)"
      .Replace "=XXXNo Entry", "No Entry", xlWhole, , False, , False, False
   End With
End Sub

WOW!! thank you all for the great codes. I will test them all and see which one gives me the least run time.

 

[Michael M]

The code provided by @Fluff will be quickest by far, because there is no loop !!!