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?

 

[pincivma]

Hi Eric

I tried your macro and it worked good. However, I ran into a problem. I wanted to do a paste special after the formulas were all done but when I tried, the paste special code did not execute. I put the paste special code after the Next r. Can you help me with this? Thanks

 

[Eric W]

What does the whole macro look like?

 

[pincivma]

OK. Here is my macro.


Sub reinstatesformulasinEquipmentPriceDetail()
'This macro runs very good. It only took 3 seconds
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

Range("D106", Range("D" & Rows.Count).End(xlUp)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False



Application.ScreenUpdating = True
Application.Calculation = OldVal
End If

End Sub

 

[Michael M]

Try....

Sub reinstatesformulasinEquipmentPriceDetail()
'This macro runs very good. It only took 3 seconds
Dim i As Long, MyData As Variant
With Application
    .ScreenUpdating = False
    .Calculation = xlManual
End With
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)"
    End If
Next r
With Range("D106", Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlAutomatic
End With
End Sub

 

[Michael M]

slight change....BTW UNTESTED

Sub reinstatesformulasinEquipmentPriceDetail()
'This macro runs very good. It only took 3 seconds
Dim i As Long, MyData As Variant
With Application
    .ScreenUpdating = False
    .Calculation = xlManual
End With
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
With Range("D106:D" & Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlAutomatic
End With
End Sub

 

[pincivma]

Try....

Sub reinstatesformulasinEquipmentPriceDetail()
'This macro runs very good. It only took 3 seconds
Dim i As Long, MyData As Variant
With Application
    .ScreenUpdating = False
    .Calculation = xlManual
End With
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)"
    End If
Next r
With Range("D106", Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlAutomatic
End With
End Sub

No Good. The macro did not execute the following code. It stops at the "."

With Range("D106", Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
End With

 

[Michael M]

sorry should have spotted that

With Range("D106:D" & Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With

 

[pincivma]

Hi Michael
I will give it a try later on today and get back to you. Not sure what the difference is but I trust you.

 

[pincivma]

Hi Michael
I will give it a try later on today and get back to you. Not sure what the difference is but I trust you.

Hi Again, Michael
I tried your macro again. The formulas do come through in column D but they are not converted to value by the code

With Range("D106:D" & Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With

What is happening is that the macro stops running on the following code

If MyData(r, 1) = "." Then Exit Sub

Turning the formulas into values code comes after the line "If MyData(r, 1) = "." Then Exit Sub". I think that is causing the following code not to execute

With Range("D106:D" & Range("D" & Rows.Count).End(xlUp))
.Value = .Value
End With

 

[Michael M]

True, you are exiting the sub if the cell only contains a period !
my question is why will a cell only contain a period??