CODEWITHSUNDEEP
excelvbaperformanceloopscheckbox
Michael Schwed
Michael Schwed

Reputation: 41

Looping over checkboxes with VBA in Excel very slow

I have an Excel Sheet with about 4500 checkboxes (I know, it sounds stupid, but it is for a customer, please do not ask...). Just wrote the VBA Sub below to uncheck all the boxes together. So far it works, but it is terribly slow, it takes more than 5 minutes until all boces are unchecked and while the Sub is running, the whole Excel Applikation grays out freezes. I know, 4500 Checkboxes is quiet a lot, but I wonder that it is really enough to bring Excel in such a trouble....Has anyone an idea?

Best Michael

Sub DeselectAll()
   Application.EnableCancelKey = False
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Dim wksA As Worksheet
   Dim intRow As Integer

   Set wksA = Worksheets("Companies")
   For intRow = 1 To 4513
      wksA.CheckBoxes("Checkbox_" & intRow).Value = False
   Next
 End Sub

Upvotes: 4

Views: 1433

Answers (4)

Noam Brand
Noam Brand

Reputation: 346

Elaborating on @Ahmed AU solution.

Select/Deselect signal/ multiple virtual checkboxs

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim isect As Range
Dim Cl As Range
Dim Prvsel As Range
Set isect = Application.Intersect(Target, Range("C1:C4000"))
If isect Is Nothing Then
Set Prvsel = Nothing  'Release multiple selection
Exit Sub
End If

' Use WINGDING font Chr (254) for checked
' Use WINGDING font Chr (111) for uncheck

If isect.Cells.Count >= 1 Then
Set Prvsel = isect        
    For Each Cl In Prvsel.Cells
            If Cl.Value = Chr(111) Then
                Cl.Value = Chr(254)
                Else
                Cl.Value = Chr(111)
            End If
    Next Cl
End If
'Go to offset cell selection
       Selection.Offset(0, 1).Select
    End Sub

Upvotes: 0

Ahmed AU
Ahmed AU

Reputation: 2777

The best answer I thumbs up for is @EvR solution. I am not trying to answer but offering an idea of a workaround.

I checked the time by adding 4000 ComboBox in blank sheet in a blank workbook with a simple 3 line loop (omg I forgot to off screen updating and calculations etc). It took around 10 minutes in my old laptop. I don’t have courage to repeat the ordeal again.

When I tried to use your piece of code with looping it is taking 3-4 seconds only and with @EvR’s solution without loop and selection is taking 1-2 seconds. These times are actual time taken with Debug.Print or writing to some cells. Actual drama unfolds after screen updates, calculations, events are enabled with the sheet active. It become highly unstable and any careless click etc cause excel to ‘not responding’ state for 2-5 mintues.

Though Customer and Boss are always right. Once in my life I succeeded to persuade someone in a similar approach of hundreds of buttons on a worksheet to something virtual. My Idea is to create virtual checkbox in the sheet. Proper cell sizing and border with validation of the cells to `=ChrW(&H2714)’ and ignore blank and a simple code like below can make it a pass-through type of work-around.

Public Prvsel As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, Cl As Range
Set isect = Application.Intersect(Target, Range("C1:C4000"))

    If isect Is Nothing Then
    Set Prvsel = Nothing  'Release multiple selection
    Exit Sub
    End If

    If isect.Cells.Count > 1 Then
    Set Prvsel = isect        'storing multiple selection for next click event
    Else
        If Target.Value = ChrW(&H2714) Then
        Target.Value = ""
        Else
        Target.Value = ChrW(&H2714)
        End If
        If Not Prvsel Is Nothing Then
            For Each Cl In Prvsel.Cells
            Cl.Value = Target.Value
            Next Cl
        End If
    End If
End Sub

ScreenShot

Upvotes: 3

EvR
EvR

Reputation: 3498

Without selection: 

Sub DeselectAll()
  With Worksheets("Companies").CheckBoxes
   .Value = xlOff
  End With
End Sub

Upvotes: 8

Gary's Student
Gary's Student

Reputation: 96753

Just don't loop.

This is a good example of when Selection can help:

To set all checkboxes:

Sub dural()
    ActiveSheet.CheckBoxes.Select
    Selection.Value = xlOn
End Sub

To uncheck all checkboxes:

Sub dural2()
    ActiveSheet.CheckBoxes.Select
    Selection.Value = xlOf
End Sub

( tested on Forms-type checkboxes )

Upvotes: 5

Related Questions