Is there a way to make this code run faster?

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

`myRange.Cells(i, j).Font.Bold = True` will be slightly faster. You would probably get a further boost by unioning a range containing cells to be bolded, then applying the bold setting to that range once you hit a certain number of cells. — Tim Williams, Nov 21 '19 at 00:34
On testing - just skipping the `Select` should give you a huge speed boost. — Tim Williams, Nov 21 '19 at 00:50

Tim Williams · Answer 1 · 2019-11-21T00:58:23.130

2

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

edited Nov 21 '19 at 00:58

answered Nov 21 '19 at 00:52

Tim Williams

154,628
8
97
125

It does indeed,brought down my calculation time dramatically! – neutronhammer Nov 21 '19 at 17:56

Ryan Wildry · Accepted Answer · 2019-11-21T17:57:25.287

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

Is there a way to make this code run faster?

2 Answers2