CODEWITHSUNDEEP
vbaexcel
Caynadian
Caynadian

Reputation: 779

Using VBA To Delete Thousands of Checkboxes

Somehow 10s of thousands of checkboxes were created in some spreadsheets that we have. I'm not sure how this happened but we cannot open the sheets in Excel 2010 only in Excel 2003 because of it. I wrote some VBA script to go through and delete the extra checkboxes and it works for most of the files. But, some files seem to have way more checkboxes than others and the script dies with an Out of Memory error. This is my script:

Sub ProcessFiles()
  Dim Filename, Pathname, LogFileName As String
  Dim wb As Workbook
  Dim fso As Object

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set log = fso.OpenTextFile("Z:\Temp\Fix.log", 8, True, 0)

  PrintLog ("*** Beginning Processing ***")

  Pathname = "Z:\Temp\Temp\"
  Filename = Dir(Pathname & "*.xls")
  Do While Filename <> ""
    PrintLog ("Opening " & Pathname & Filename)
    Set wb = Workbooks.Open(Pathname & Filename)
    DoWork wb
    PrintLog ("Saving file " & Pathname & Filename)
    wb.Close SaveChanges:=True
    Filename = Dir()
  Loop

  log.Close
End Sub

Sub DoWork(wb As Workbook)
  Dim chk As CheckBox
  Dim c As Integer

  With wb
    Worksheets("Vessel & Voyage Information").Activate
    PrintLog ("Getting count of checkboxes")
    c = ActiveSheet.CheckBoxes.Count
    PrintLog (c & " checkboxes found")
    If (c <= 43) Then
      PrintLog ("Correct # of checkboxes.  Skipping...")
    Else
      c = 0
      For Each chk In ActiveSheet.CheckBoxes
        If Not (Application.Intersect(chk.TopLeftCell, Range("D29:D39")) Is Nothing) Then
          chk.Delete
          c = c + 1
        End If
      Next
      PrintLog ("Deleted " & c & " checkboxes.")
    End If
  End With
End Sub

Public Sub PrintLog(argument As String)
    If Not log Is Nothing Then
        log.WriteLine Format(Now(), "yyyy-MM-dd hh:mm:ss") & ": " & argument
    End If
End Sub

The script fails at the c = ActiveSheet.CheckBoxes.Count in DoWork or, if I comment that line out, then at the For Each chk In ActiveSheet.CheckBoxes. I am guessing that calling ActiveSheet.CheckBoxes gathers up all the checkboxes and there are too many so it dies.

Is there a way to step through each checkbox on a worksheet without using ActiveSheet.CheckBoxes?

Upvotes: 2

Views: 220

Answers (2)

Florent B.
Florent B.

Reputation: 42538

I would try with the shape collection and with an indexer intead of an iterator:

Sub DeleteCheckBoxes()
  Dim itms As shapes, i&, count&, deleted&
  Set itms = ActiveSheet.Shapes

  On Error GoTo ErrHandler
  For i = 1& To &HFFFFFFF
    If itms(i).Type = msoFormControl Then
      If itms(i).FormControlType = xlCheckBox Then
        count = count + 1
        If count > 43 Then 
          itms(i).Delete
          deleted = deleted + 1
          i = i - 1
        End If
      End If
    End If
  Next

ErrHandler:
  Debug.Print "Count   " & count
  Debug.Print "Deleted " & deleted
End Sub

Upvotes: 2

BruceWayne
BruceWayne

Reputation: 23285

From this page, does this work:

Sub Count_CheckBoxes()
Dim cnt     As Long
Dim cbx     As OLEObject

cnt = 0
'Count CheckBoxes
For Each cbx In ActiveSheet.OLEObjects
    If TypeName(cbx.Object) = "CheckBox" Then
        cnt = cnt + 1
    End If
Next

End Sub

Upvotes: 0

Related Questions