Code slowing down

[Chesterdave]

Hiya,

I have a 28 page word doc that some of our employees use which has around 260 checkboxes. There is a table on page 2 that records their checkbox clicks and can grow to no larger then 64 rows. The checkboxes start on page 6 and go up to page 20.
The issue I have is when unchecking boxes it starts to slow down, but it only happens to checkboxes that are towards the bottom of the document.
e.g. unchecking a box on page 20 and deleting row from table; time taken < 0.2 seconds, if I then uncheck another box; time taken < 0.3 seconds and so on until eventually it takes over 3 seconds to uncheck and delete a row. Even if the table is no larger then 1 row, it still slows down.
But this does not affect check boxes on page 6, I can check and uncheck those all day long and they never slow down.

I'm pretty new to all this so I'm probably doing something stupid, here is the code that deletes the row from the table based on which checkbox has been selected. Any help or pointers would be appreciated.


Public Sub DeleteRow(ByVal StrChkNm As String, StrChkNm2 As String) 'Looks for which row to delete based on which checkbox has been unticked. e.g. 2A R

Dim r As Long
Dim StrDel1 As String
Dim StartTime As Double
Dim SecondsElapsed As Double

StartTime = Timer 'timing the code; captures the start time

If Len(StrChkNm) = 5 Then
StrDel1 = Right(StrChkNm, 3) 'StrChkNm is taken from the caption property field of the checkbox
Else
StrDel1 = Right(StrChkNm, 2) 'StrChkNm is taken from the caption property field of the checkbox
End If

'loops through table2 and deletes the row based on the checkbox selection
With ThisDocument.Tables(2)
For r = 1 To .Rows.Count
If (InStr(.Cell(r, 1).Range.Text, StrDel1) And Len(StrChkNm) = Len(.Cell(r, 1).Range.Text)) And InStr(.Cell(r, 4).Range.Text, StrChkNm2) Then
.Rows(r).Delete 'delete the row
SecondsElapsed = Round(Timer - StartTime, 2) 'timing the code; captures the end time
MsgBox "delete " & SecondsElapsed & " seconds", vbInformation 'timing the code; displays the total time taken
Call Countcheckboxes
ActiveDocument.UndoClear
Exit Sub
End If
Next
End With

End Sub

thanks

[mikewi]

Chesterdave I'm new to VBA as well and I don't know how to solve this problem but do you have a sample of the sheet you could share? I create large checklists for auditing that can get quite large (50-100+pages) and since we don't always need every row I go through and delete one row at a time. The process you explained here would save me a ton of time.

[mikewi]

I'm wondering if it's possible that when you start your search for checkboxes it can start from 2 places. Instead of just starting at the beginning it could start a second search from the half way point of the documents as well?

[gmayor]

While there is some confusion in your code between ThisDocument and ActiveDocument, and when deleting rows from a table in a loop it is better to start from the end of the table so as not to confuse the count,

With ThisDocument.Tables(2) 'ThisDocument?
For r = .Rows.Count To 1 Step -1
If (InStr(.Cell(r, 1).Range.Text, StrDel1) And _
Len(StrChkNm) = Len(.Cell(r, 1).Range.Text)) _
And InStr(.Cell(r, 4).Range.Text, StrChkNm2) Then
.Rows(r).Delete 'delete the row
SecondsElapsed = Round(Timer - StartTime, 2) 'timing the code; captures the end time
MsgBox "delete " & SecondsElapsed & " seconds", vbInformation 'timing the code; displays the total time taken
Call Countcheckboxes
ActiveDocument.UndoClear
Exit For
End If
Next r
End Withthe problem more likely lies in the process that calls the sub.

We have no idea what the code of Countcheckboxes is?

If you are using checkboxes, it would be worth using checkbox content controls as these process much more quickly than formfield controls - especially if you are using Word 2013/2016, which is slower than 2010 at processing fields. Unfortunately you have only given us half the picture.

[Chesterdave]

Hi everyone, thanks for replying.

This class handles the checkboxes:

Public WithEvents myCheckBox As MSForms.CheckBox
------------------------------------------
Public Sub myCheckBox_Click()


StrChkNm = myCheckBox.Caption 'Property field on the checkbox
StrChkNm2 = myCheckBox.GroupName 'Property field on the checkbox

If myCheckBox.Value = True Then
ActiveDocument.UndoClear
Call ThisDocument.AddRow(StrChkNm, StrChkNm2)
Else
ActiveDocument.UndoClear
Call ThisDocument.DeleteRow(StrChkNm, StrChkNm2)
End If


End Sub

Both AddRow and DeleteRow subs call countcheckboxes sub and AddRow works fine, no slow down at all, but I can paste it in if it will help.

gmayor, I'm using word 2010. I can't play to much at the moment as I'm on a training course but I will make the changes you suggested and let you know if it worked.
Something else I noticed is that if I create a new table at the end of the document and point my code at that one, the checkboxes at the bottom of the document work fine. Its the ones at the top which now show the issue of gradually slowing down with each delete.

Mikewi, I'm not sure I can give you the document as its an official government doc, but this website gave me enough pointers to get started
forums.atomicmpc.com.au/index.php/topic/18556-word-vba-assigning-events-to-checkboxes/

Hope it helps

[gmaxey]

Generally any time you can index something directly rather than use a loop you are better off. Just an exercise, I created a small proof of concept document using CCs and their built-in exit event. Perhaps you could apply a similar process.

[Kilroy]

After re-reading this thread I was looking at the problem all wrong. I thought for some reason that the check boxes when checked would be like deciding what rows to keep in a table. Some of my checklists are 50-100page plus with numerous rows on each page which I have to go through and delete upwards of half depending on what elements I'm auditing. The thought of having a checkbox so that after running the macro it only kept the rows with a checked box or ideally only copied those lines to a new document was very interesting.

[gmaxey]

Chesterdave,

Can you post a sanitized version of your document (just a simple table and a few representative checkboxes) with the associate code to add and delete rows. There must be a way to delete a targeted row and get rid of the loop.

[Chesterdave]

Hiya,

Good idea!

Here is the doc, stripped of all text. If you add/delete repeatedly from row 12a you should start to notice it slowing down. Doesn't matter how big a pause you put in between each click, so it doesn't look like its actions stacking up waiting to be processed. I've also noticed whilst trying different things that the issue does not always appear, but I've not been able to work out what stops/causes it.

Some of it needs to be written better to be more efficient but I'm only asking it at times to delete one row from a 2 row table

[gmaxey]

Lets try this. Rename the class clsCB and use this code:


Option Explicit
Private strChkName As String
Private strChkGroupName As String
Public WithEvents oChkBox As MSForms.CheckBox
Public Sub oChkBox_Click()
strChkName = oChkBox.Caption 'Property field on the checkbox
strChkGroupName = oChkBox.GroupName 'Property field on the checkbox
With ThisDocument
.UndoClear
If oChkBox Then
.AddRow strChkName, strChkGroupName
Else
.DeleteRow strChkName, strChkGroupName
End If
End With
lbl_Exit:
Exit Sub
End Sub

And use this code in the document:


Option Explicit
Dim CheckBoxes() As New clsCB
Dim oRow As Row
Dim oRng As Range
Dim strBMName As String
Dim strRef As String
Public Sub Document_Open()
Dim oILS As InlineShape
Dim lngCBCount As Integer
lngCBCount = 1
For Each oILS In Me.InlineShapes
Select Case oILS.OLEFormat.ClassType
Case "Forms.CheckBox.1"
ReDim Preserve CheckBoxes(1 To lngCBCount)
Set CheckBoxes(lngCBCount).oChkBox = oILS.OLEFormat.Object
If CheckBoxes(lngCBCount).oChkBox.GroupName <> "ignore" Then 'ignores checkboxes with ignore as the groupname property
lngCBCount = lngCBCount + 1
End If
End Select
Next oILS
Set oILS = Nothing
lbl_Exit:
Exit Sub
End Sub

Public Sub AddRow(ByRef strRef As String, strType As String)
strRef = Mid(strRef, 3, Len(strRef) - 2)
strBMName = "BM_" & strRef & "N" & strType
Set oRow = ThisDocument.Tables(1).Rows.Add 'creates new row on the table
oRow.Cells(1).Range.Text = strRef 'Adds to first cell on last row (2A)
oRow.Cells(4).Range.Text = strType 'Adds to fourth cell on last row (R, M, O, Cr)
oRow.Cells(2).Range.Text = "N" 'Adds N to second cell on last row
Set oRng = oRow.Range
oRng.End = oRng.End - 2
oRng.Collapse wdCollapseEnd
ActiveDocument.Bookmarks.Add strBMName, oRng
Countcheckboxes
ThisDocument.UndoClear
lbl_Exit:
Exit Sub
End Sub
Public Sub DeleteRow(ByRef strRef As String, strType As String)
strRef = Mid(strRef, 3, Len(strRef) - 2)
strBMName = "BM_" & strRef & "N" & strType
If ActiveDocument.Bookmarks.Exists(strBMName) Then
Set oRow = ActiveDocument.Bookmarks(strBMName).Range.Rows(1)
oRow.Delete
End If
Countcheckboxes
ThisDocument.UndoClear
End Sub

[Paul_Hossler]

some other minor observations / suggestions


1. Redim Preserve takes a lot of time, esp if you do it inside a loop, so you can just do it once at the end



Public Sub Document_Open()

Dim ils As InlineShape
Dim intCheckBoxCount As Integer


ReDim CheckBoxes(1 To Me.InlineShapes.Count)

intCheckBoxCount = 1

For Each ils In Me.InlineShapes
Select Case ils.OLEFormat.ClassType

Case "Forms.CheckBox.1"
Set CheckBoxes(intCheckBoxCount).myCheckBox = ils.OLEFormat.Object
If CheckBoxes(intCheckBoxCount).myCheckBox.GroupName <> "ignore" Then 'ignores checkboxes with ignore as the groupname property
intCheckBoxCount = intCheckBoxCount + 1
End If

End Select
Next

ReDim Preserve CheckBoxes(1 To intCheckBoxCount)

End Sub



2. Similar, the 'Like' operator takes a lot of time, so if you can eliminate that



With ThisDocument.Tables(1) 'looks at all the rows and adds up the O's, M's, Cr's and R's
For r = 2 To .Rows.Count
Select Case Left(.Cell(r, 4).Range.Text, 1)
Case "R"
StrR = StrR + 1
Case "O"
StrO = StrO + 1
Case "M"
StrM = StrM + 1
Case "C"
StrCr = StrCr + 1
End Select
Next r
End With

[gmaxey]

Regarding Pauls suggestion 1. Perhaps:


Dim oILS As InlineShape
Dim lngCBCount As Integer
ReDim Preserve CheckBoxes(1 To Me.InlineShapes.Count)
lngCBCount = 1
For Each oILS In Me.InlineShapes
Select Case oILS.OLEFormat.ClassType
Case "Forms.CheckBox.1"
If oILS.OLEFormat.Object.GroupName <> "ignore" Then
Set CheckBoxes(lngCBCount).oChkBox = oILS.OLEFormat.Object
lngCBCount = lngCBCount + 1
End If
End Select
Next oILS
ReDim Preserve CheckBoxes(1 To lngCBCount - 1)
lbl_Exit:
Set oILS = Nothing
Exit Sub
End Sub

[gmaxey]

Chester,

After pondering the application of your document sample, it seems that you would want the six check boxes per row to be mutually exclusive. Why would something be NA and a Critical deficiency. Consider this:


Sub Document_Open()
Dim oILS As InlineShape
Dim lngCBCount As Integer
ReDim Preserve CheckBoxes(1 To InlineShapes.Count)
lngCBCount = 1
For Each oILS In Me.InlineShapes
If oILS.OLEFormat.ClassType = "Forms.CheckBox.1" Then
Set CheckBoxes(lngCBCount).oChkBox = oILS.OLEFormat.Object
lngCBCount = lngCBCount + 1
End If
Next oILS
ReDim Preserve CheckBoxes(1 To lngCBCount - 1)
lbl_Exit:
Set oILS = Nothing
Exit Sub
End Sub

and change your classs to this:


Option Explicit
Public WithEvents oChkBox As MSForms.CheckBox
Public Sub oChkBox_Change()
Dim oCell As Cell
Dim oILS As InlineShape
Set oCell = Selection.Cells(1)
With ThisDocument
.UndoClear
If oChkBox Then
If oChkBox.GroupName <> "ignore" Then
.AddRow oChkBox.Caption, oChkBox.GroupName
End If
For Each oILS In oCell.Row.Range.InlineShapes
If Not oILS.Range.InRange(oCell.Range) Then
oILS.OLEFormat.Object.Value = False
End If
Next oILS
Else
If oChkBox.GroupName <> "ignore" Then
.DeleteRow oChkBox.Caption, oChkBox.GroupName
End If
End If
End With
lbl_Exit:
Set oILS = Nothing: oCell = Nothing
Exit Sub
End Sub

[gmaxey]

Here it is revised and cut down to 5 areas.

[Paul_Hossler]

Regarding Pauls suggestion 1. Perhaps:





ReDim Preserve CheckBoxes(1 To lngCBCount - 1)


:beerchug:

[Chesterdave]

Big thank you to everyone, especially gmaxey and Paul, had a quick play and it looks like the problem has been solved AND the functionality has also been improved :bow: