Makro Performance

[embi_]

Hey friends,

I have two sheets where I have the same colored cells that each have a number. On the first sheet I only want the numbers below 50 and in the other above 50.
I wrote a code for a command button to do so. The one code that deletes all the numbers above 50 takes about half a second to go through these ~12000 cells.
The second one takes over 2 minutes to delete the values below 50.
Does anybody know what factor there comes into play, that the second one is so much slower?

The codes are:

Delete values above 50:

Private Sub CommandButton1_Click()
For Each cell In Range("E14:EF108")
  If cell.Value >= 50 Then
    cell.ClearContents
    cell.Interior.Color = RGB(255, 255, 255)
    cell.Interior.Pattern = xlSolid
  End If
Next cell


End Sub

Delete values below 50:

Private Sub CommandButton1_Click()
For Each cell In Range("E14:EF108")
  If cell.Value < 50 Then
    cell.ClearContents
    cell.Interior.Color = RGB(255, 255, 255)
  End If
Next cell


End Sub

 

[lrobbo314]

Try this

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim r As Range: Set r = Range("E14:EF108")
Dim AR() As Variant: AR = r.Value

For i = LBound(AR) To UBound(AR)
    For j = LBound(AR) To UBound(AR, 2)
        If AR(i, j) >= 50 Then
            AR(i, j) = vbNullString
            Cells(i + 13, j + 4).Interior.Color = RGB(255, 255, 255)
            Cells(i + 13, j + 4).Interior.Pattern = xlSolid
        End If
    Next j
Next i

r.Value = AR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Peter_SSs]

Does anybody know what factor there comes into play, that the second one is so much slower?

Are there a lot of blank cells in the range? They would meet the criteria of < 50 so there might be a lot more to process the way your code stands.

 

[embi_]

Are there a lot of blank cells in the range? They would meet the criteria of < 50 so there might be a lot more to process the way your code stands.

Yes! That was the problem!

Private Sub CommandButton1_Click()
For Each cell In Range("E14:EF108")
  If cell.Value > 0 And cell.Value < 50 Then
    cell.ClearContents
    cell.Interior.Color = RGB(255, 255, 255)
  End If
Next cell


End Sub

With this code its way faster! Thanks!

 

[Peter_SSs]

Yes! That was the problem!

With this code its way faster! Thanks!

Good news!