"Object Library Invalid" Error occurring...why?

[omokeefe]

I wrote 2 .vba subs, one to create a # of lines and create 3 check
boxes, and another to delete a number of lines and their check boxes.
This code works fine, but after a little while I"ll get the "Object
Library Invalid or contains references to object definitions that
could not be found" error. Any ideas how to fix?

Private Sub CommandButton1_Click()
Dim KeyWord As String
Dim iA As Integer

RowNum = Application.InputBox( _
Prompt:="Enter the Number of Rows to Create:", _
Title:="Create How Many?", Type:=1)

Cells(1, 1).Select
KeyWord = "AAAAA"
i = 1
Do While i < RowNum + 1
iA = 1
Set NameAddress = Cells.Find(What:=KeyWord, after:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart,
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
NameAddress.Select
If NameAddress Is Nothing Then
MsgBox "Not found"
Else:
ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Select
ActiveCell.Offset(0, 6).Select

Do While iA <= 3
top1 = ActiveCell.Top + 2
left1 = ActiveCell.Left + (ActiveCell.Width / 2) - 5

Set box1 =
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1")
box1.Left = left1
box1.Top = top1
box1.Width = 16.5
box1.Height = 10.5
box1.Name = "boxA" & i * iA
ActiveCell.Offset(0, 2).Select
iA = iA + 1
Loop
End If
i = i + 1
Loop
End Sub

Private Sub CommandButton2_Click()
Dim KeyWord As String
Dim iA As Integer

DelNum = Application.InputBox( _
Prompt:="Enter the Number of Rows to Delete:", _
Title:="Delete How Many?", Type:=1)

Cells(1, 1).Select
KeyWord = "AAAAA"
i = 1
Do While i < DelNum + 1
iA = 1
Set NameAddress = Cells.Find(What:=KeyWord, after:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart,
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
NameAddress.Select
If NameAddress Is Nothing Then
MsgBox "Not found"
Else:

ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Select
Selection.Delete
ActiveCell.Select
ActiveCell.Offset(0, 6).Select

Do While iA <= 3
ActiveSheet.Shapes("boxA" & i * iA).Delete
iA = iA + 1
Loop
End If
i = i + 1
Loop
End Sub

 

[TomPl]

The problem seems to be identifying the name of the checkbox to be deleted.
I can't figure out how to do that because the row numbers can change due to
insertions or deletion but the name of the checkbox does not change.
Instead, I elected to delete all checkboxes that have the same top location
as the the row I am trying to delete. This is the result. Sorry, I took the
liberty to pretty drastically modify your routine.

Private Sub CommandButton1_Click()
Dim intChkBoxs As Integer
Dim intCounter As Integer
Dim intAdds As Integer
Dim rngNameAddr As Range
Dim Top1 As Variant
Dim Left1 As Variant

intAdds = Application.InputBox( _
Prompt:="Enter the Number of Rows to Create:", _
Title:="Create How Many?", Type:=1)
Cells(1, 1).Select
For intCounter = 1 To intAdds
Set rngNameAddr = Cells.Find(What:="AAAAA", after:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
rngNameAddr.Select
If rngNameAddr Is Nothing Then
MsgBox "Not found"
Else:
ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Copy
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(-1, 6).Select
For intChkBoxs = 1 To 3
Top1 = ActiveCell.Top + 2
Left1 = ActiveCell.Left + (ActiveCell.Width / 2) - 5
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1")
.Left = Left1
.Top = Top1
.Width = 16.5
.Height = 10.5
End With
ActiveCell.Offset(0, 2).Select
Next intChkBoxs
End If
Next intCounter
End Sub

Private Sub CommandButton2_Click()

Dim intCounter As Integer
Dim intDeletes As Integer
Dim rngNameAddr As Range
Dim varTop As Variant
Dim varChkBox As Variant

intDeletes = Application.InputBox( _
Prompt:="Enter the Number of Rows to Delete:", _
Title:="Delete How Many?", Type:=1)
Cells(1, 1).Select
For intCounter = 1 To intDeletes
Set rngNameAddr = Cells.Find(What:="AAAAA", after:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
rngNameAddr.Select
If rngNameAddr Is Nothing Then
MsgBox "Not found"
Else:
varTop = ActiveCell.Offset(-2, 0).Top + 1.5
For Each varChkBox In ActiveSheet.Shapes
If varChkBox.Top = varTop Then
varChkBox.Delete
End If
Next varChkBox
ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Delete
Cells(1, 1).Select
End If
Next intCounter
End Sub

PS - Your error routine for when the text string is not found doesn't work.
I didn't address that in my solution.