Macro is slow

[Deepk]

Hi all,

find below a code for coloring cell based on the adjacent cell value. This code is running very slow, especially if the data in selection is more than 2000. Please help.

Private Sub CommandButton2_Click()
 Dim c As Range


    firstVal = 0
    cellColor = 0
       
  With Selection
    
    If Selection.Rows.Count > 100000 Then
      MsgBox Prompt:="Please verify the data you have selected", Title:="Wrong selection!"
      Exit Sub
    Else
      For Each c In Selection
        If c.Interior.Color <> cellColor Then
            firstVal = firstVal + 1
            cellColor = c.Interior.Color
     End If
        Cells(c.Row, c.Column - 1).Value = firstVal
      Next c
    End If
  End With
    MsgBox "Process Completed Successfully."
    Unload UserForm2
End Sub

 

[My Aswer Is This]

I only see one small thing you could change. I changed it and marked it in red.
Please define "Slow" do you mean this takes 3 minutes or 3 seconds.

Private Sub CommandButton2_Click()
 Dim c As Range

    firstVal = 0
    cellColor = 0
       
  With Selection
    
    If Selection.Rows.Count > 100000 Then
      MsgBox Prompt:="Please verify the data you have selected", Title:="Wrong selection!"
      Exit Sub
    Else
      For Each c In Selection
        If c.Interior.Color <> cellColor Then
            firstVal = firstVal + 1
            cellColor = c.Interior.Color
     End If
       [COLOR=#ff0000] 'Cells(c.Row, c.Column - 1).Value = firstVa  old linel
      c.Offset(, -1).Value = firstVal  'New line[/COLOR]
      Next c
    End If
  End With
    MsgBox "Process Completed Successfully."
    Unload UserForm2
End Sub

Why do you have a UserForm open?
Try closing the UserForm at the beginning of the script
Or explain to me more about what this script is doing.

 

[PatOBrien198]

You might also want to try turning off screen updating and (especially) automatic calculations...

'at beginning of macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual



'at end of macro
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic