Question

I am having a bit of trouble with errors occurring in a loop in VBA. First, here is the code I am using

dl = 20
For dnme = 1 To 3
Select Case dnme
Case 1
drnme = kt + " 90"
nme = "door90"
drnme1 = nme
Case 2
drnme = kt + " dec"
nme = "door70" 'decorative glazed'
Case 3
drnme = kt + " gl"
nme = "door80" 'plain glazed'
End Select

On Error GoTo ErrorHandler
Set sh = Worksheets("kitchen doors").Shapes(drnme) 'This line here is where the problem is'
sh.Copy
ActiveSheet.Paste
    Selection.ShapeRange.Name = nme
    Selection.ShapeRange.Top = 50
    Selection.ShapeRange.Left = dl
    Selection.ShapeRange.Width = 150
    Selection.ShapeRange.Height = 220
25
dl = dl + 160
Next dnme

 Exit Sub
ErrorHandler:

GoTo 25

The problem is that when it tries to access the shape, the shape doesn’t always exist. The first time through the loop, this is fine. It goes to the ErrorHandler and everything works good. The second time it goes through and can’t find the shape, it comes up with the “End/Debug” error box. I can’t work out why it doesn’t just go straight to the ErrorHandler. Any suggestions?

Answer 1

First of all you have a for loop with only 3 iterations, and you have a switch case for three!!. why can’t you move your common code to a new function and call it thrice?

And more over each error has a unique number (incase of VBA errors like Subscript out of range etc, or a description if its a generic number like 1004, and other office errors). You need to check the error number, then decide how to proceed, if to skip the part or work around.

Please go through this code..I have moved your comon code to a new function, and in that function we will be resizing the shape.
If the shape is missing then we will just return false, and move to next shape.

'i am assuming you have defined drnme, nme as strings and d1 as integer
'if not please do so
Dim drnme As String, nme As String, d1 As Integer

dl = 20

drnme = kt + " 90"
nme = "door90"
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If
'Just call 
'ResizeShape(drnme, nme, d1)
'd1 = d1 + 160
'If you don't care if the shape exists or not to increase d1
'in that case whether the function returns true or false d1 will be increased

drnme = kt + " dec"
nme = "door70" 'decorative glazed'
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If

drnme = kt + " gl"
nme = "door80" 'plain glazed'
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If

ActiveSheet.Shapes("Txtdoors").Select
Selection.Characters.Text = kt & ":   " & kttxt
Worksheets("kts close").Protect Password:="UPS"


End Sub

'resizes the shape passed in.
'if the shape does not exists then returns false.
'in that case you can skip incrementing d1 by 160

Public Function ResizeShape(drnme As String, nme As String, d1 As Integer) As Integer
On Error GoTo ErrorHandler
Dim sh As Shape
Set sh = Worksheets("kitchen doors").Shapes(drnme)
sh.Copy
ActiveSheet.Paste
Selection.ShapeRange.Name = nme
Selection.ShapeRange.Top = 50
Selection.ShapeRange.Left = dl
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 220
Exit Function
ErrorHandler:
'Err -2147024809 will be raised if the shape does not exists
'then just return false
'for the other errors you can examine the number and go back to next line or the same line
'by using Resume Next or Resume
'not GOTO!!
If Err.Number = -2147024809 Or Err.Description = "The item with the specified name wasn't found." Then
    ResizeShape = False
    Exit Function
End If
End Function