For loop setting Font and Interior of Range taking

Question

I have a sheet with a lot of data (almost 14.000 rows and 13 columns).

I am running a For loop within this sheet but it takes sometimes over 2 minutes to complete it. Also the application is not responding during the For loop.

Is there a way I can re-write my loop so it will run a lot faster?

Here is my code:

For counter = 1 To Rows.Count
    If Cells(counter, 13).Value > 500 Then
        Cells(counter, 13).Interior.ColorIndex = 37
        Cells(counter, 13).Font.Color = Black
        Cells(counter, 13).Font.Bold = True
    End If
    count = count + 1
    Application.StatusBar = count
Next counter

Thanks in advance :).

Answer 1

Avoid looping through a range. You can speed up your code by looping through an array and do formatting after it. Furthermore you could split your loop for the status bar count into portions.

Code

Option Explicit

Public Sub Greater500()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet")
Dim v As Variant
Dim i As Long, n As Long, m As Long, r As Long
Dim t As Double
' stop watch
  t = timer
' get last row in column M
  n = ws.Range("M" & ws.Rows.Count).End(xlUp).Row
' get values to one based 2dim array
  v = ws.Range("M1:M" & n).value
' clear existing colors over the WHOLE column to minimize file size
      ws.Range("M:M").Interior.ColorIndex = xlColorIndexNone

  For i = 1 To n
      ' avoid troubles with formula errors, e.g. divisions :/ zero
        If IsError(v(i, 1)) Then
      ' check condition (neglecting date, string and boolean data types)
        ElseIf Val(v(i, 1)) > 500 Then
           ws.Cells(i, 13).Interior.ColorIndex = 37
           ws.Cells(i, 13).Font.Color = vbBlack
           ws.Cells(i, 13).Font.Bold = True
        End If
  Next i
  MsgBox "Time needed: " & Format(timer - t, "0.00") & " seconds."
End Sub

Answer 2

Rows.Count includes every row, not just the ones with data. (1,048,576 rows in Excel 2016). The status bar shouldn't slow it down too much.

Sub test()
    Dim c As Range, count As Integer
    Worksheets("Sheet1").Activate
    ActiveSheet.UsedRange.Select
    For Each c In Application.Selection.Cells
        If Cells(c.Row, 13).Value > 500 Then
            Cells(c.Row, 13).Interior.ColorIndex = 37
            Cells(c.Row, 13).Font.Color = Black
            Cells(c.Row, 13).Font.Bold = True
            count = count + 1
        End If
        Application.StatusBar = count
    Next c
End Sub

Answer 3

The reason your code slows down is it takes all the rows when you're writing Rows.Count.

Try to limit your range and update the format at once at the very end which should fix your problem.

Below code takes 50000 cells and completes in more or less 8 seconds on my machine.

I also tried for each loop with almost same times.

Sub test()

    Dim counter As Long
    Dim count As Long
    Dim st As Double
    Dim et As Double
    Dim tottime As Double
    Dim rangetoformat As Range

    'remove timer
    st = Timer

    For counter = 1 To 50000
        If Not rangetoformat Is Nothing Then
            If Cells(counter, 13).Value > 500 Then
                Set rangetoformat = Union(rangetoformat, Cells(counter, 13))
            End If
        Else
            Set rangetoformat = Cells(counter, 13)
        End If
        count = count + 1
        Application.StatusBar = count
    Next counter

    rangetoformat.Cells.Interior.ColorIndex = 37
    rangetoformat.Cells.Font.Color = Black
    rangetoformat.Cells.Font.Bold = True

    'remove timer
    et = Timer
    totaltime = et - st
    MsgBox totaltime

End Sub