Efficient way to loop through ListRows and perform action

Question

I have the following code that loops through every row of a large table and a subset of columns for each row. The intent is to, where a cell's formula returns a value, do a paste special values on that cell, set protection to TRUE, and change the cells format. Is there a more efficient way to do these actions?

Dim lo As ListObject
Set lo = ws.ListObjects("listobject")

For Each lr in lo.ListRows
>If [BOOLEAN] Then
>>lr.Range.Copy
>>lr.PasteSpecial Paste:=xlPasteValues
>>lr.Locked = TRUE
>>lr.Interior.Color = [COLOR]
>>lr.Font.Color = [COLOR]
>End If
Next lr

I have all the usual efficiency methods in place, manual calculation, no screen updating, no events, etc..., but this is still by far the most time consuming step in the overall process.

Answer 1

This code avoids looping rows:

Sub demo()
    Dim lo As ListObject, rTarget As Range
    Dim ws As Worksheet, rCell As Range
    Set ws = ActiveSheet
    '    Set lo = ws.ListObjects("listobject")
    Set lo = ws.ListObjects(1)
    On Error Resume Next
    ' Get the cells which have formula in table
    Set rCell = lo.DataBodyRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    If Not rCell Is Nothing Then
        For Each c In rCell
            If c.Value <> "" Then
                If rTarget Is Nothing Then
                    Set rTarget = c
                Else
                    Set rTarget = Union(rTarget, c)
                End If
            End If
        Next
        For Each c In rTarget.Areas
            ' Overwirte cells' formula with its value
            c.Value = c.Value
            ' Update format
            c.Interior.Color = vbYellow
            c.Font.Color = vbRed
            c.Locked = True
        Next
    End If
End Sub