Is there a way to make this code run faster? - arrays

Question

I have an excel range with 67 columns and about 4500 rows. The objective is to replace values in a row with hardcoded values in the 67th column of each row and then mark the ones that have have been replaced.
So I need to check each cell in a row (of 66 columns) and see if they satisfy a certain condition, before replacing them with the said hardcoded value at the very end of the row. My run time is about 360 seconds on average, when I mark the replaced values as Bold text.
Sub searchreplace()
Dim StartTime As Double
Dim Seconds As Double
StartTime = Timer
Dim i As Long
Dim j As Long
Dim arr As Variant
Dim myRange As Range
Dim Rng As String
Dim wb As Workbook
Dim SheetName As String
Dim LessThanEqual As Long
Application.ScreenUpdating = False
Set wb = ThisWorkbook
SheetName = "INPUT_WIND"
Rng = "C3:BQ4466"
LessThanEqual = 1
Set myRange = wb.Worksheets(SheetName).Range(Rng)
arr = myRange.Value
'i = rows = Ubound(arr,1)
'j=columns = Ubound(arr,2)
'loop through rows and clmns
For i = 1 To UBound(arr)
For j = 1 To myRange.Columns.Count
If arr(i, j) <= LessThanEqual Then
arr(i, j) = arr(i, 67)
myRange.Cells(i, j).Select
With Selection
.Font.Bold = True
End With
ElseIf IsEmpty(arr(i, j)) = True Then
arr(i, j) = arr(i, 67)
End If
Next j
Next i
myRange.Value = arr
Seconds = Round(Timer - StartTime, 2)
MsgBox "Fertig" & Seconds & "Seconds", vbInformation
Application.ScreenUpdating = True
End Sub

Answer 1

Instead of this:
myRange.Cells(i, j).Select
With Selection
.Font.Bold = True
End With
do this:
myRange.Cells(i, j).Font.Bold = True
It will be up to >10x faster.
See here for more: How to avoid using Select in Excel VBA

Answer 2

Here's a full example detailing using Union to keep track of which cells qualify to receive the bold, then apply that formatting in one shot. It's taking about a second on my machine to complete.
Option Explicit
Sub searchreplace()
Const LessThanEqual As Long = 1
Dim StartTime As Double
Dim i As Long
Dim j As Long
Dim arr As Variant
Dim myRange As Range
Dim wb As Workbook
Dim UnionRange As Range
StartTime = Timer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set myRange = wb.Worksheets("INPUT_WIND").Range("C3:BQ4466")
arr = myRange.Value
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
If IsEmpty(arr(i, j)) = False And arr(i, j) <= LessThanEqual Then
If UnionRange Is Nothing Then
Set UnionRange = myRange.Cells(i, j)
Else
Set UnionRange = Union(UnionRange, myRange.Cells(i, j))
End If
ElseIf IsEmpty(arr(i, j)) Then
arr(i, j) = arr(i, 67)
End If
Next
Next
UnionRange.Font.Bold = True
myRange.Value = arr
Debug.Print "This took: " & Round(Timer - StartTime, 2) & " Seconds"
Application.ScreenUpdating = True
End Sub