How to quicken a do loop that takes 23 minutes?

Hi all,

I've recently started using VBA and I've done a relatively simple macro, but it's using Do Loops. When I ran this macro over my entire range (around 4500 cells) it took 23 minutes. My code is below, highlighted in red is the text that I need to ideally change so that my code runs faster. Does anyone have any suggestions?

-------------------------------------------
Sub WeekdayColumn()
'
' Add weekday column into incident data
'

'
Sheets("Incident Data").Select
Dim RowCount As Integer
RowCount = ActiveSheet.Range("A1").End(xlDown).row
Range("P1").Select
ActiveCell.FormulaR1C1 = RowCount

Application.ScreenUpdating = False

Range("A1").Select
Selection.End(xlToRight).Select
Selection.EntireColumn.ClearContents
ActiveCell.Offset(1, 0).Range("A1").Select

Dim i As Integer, StartTime As Date

StartTime = Now()

Call WeekdayFormulaDoLoop

ActiveCell.Offset(-1, 0).Range("A1").ClearContents
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "Weekday"
Range("P1").Select
Selection.ClearContents

MsgBox Format(Now() - StartTime, "hh:mm:ss")

End Sub

Sub WeekdayFormulaDoLoop()
'
' WeekdayFormula Macro
'

Do Until ActiveCell.Offset(0, -1) = ""
For i = 1 To Range("P1")
Application.StatusBar = "Rows to Process..." & Range("P1") - i

ActiveCell.FormulaR1C1 = "=WEEKDAY(RC[-12],2)"
ActiveCell.Offset(1, 0).Range("A1").Select

Next i

Loop

Application.StatusBar = False

ActiveCell.ClearContents

End Sub
-------------------------------------------

Thanks!

In addition to setting the calculation mode to manual and not selecting everything before processing - you could try this instead of the loop in Sub WeekdayFormulaDoLoop

Please Login or Register  to view this content.

That would be the entire content of that procedure assuming the correct initial cell was selected first. The value in range P1 was decreased as you seem to count all used rows but start processing in Row 2 so the value in P1 is overstated by 1.

There are other things than can speed this up but nothing as effective as removing the loop.

Thanks so much, this worked perfectly!!

Originally Posted by AlphaFrog

You can apply the formula to an entire range all at once. Selecting each cell and doing it one at a time takes a lot longer.

This will apply the formula to the active cell down to the last used row in the adjacent column .

Please Login or Register  to view this content.

This worked perfectly, thank you!!