VBA code doesn't recognize shape has been deleted

Qqqqq

New Member
Joined
Feb 6, 2014
Messages
48
I used a macro to add a hyperlinked index to a couple workbooks with lots of tabs. I have another macro that adds a Return to Index button - a rectangle shape assigned to a Return to Index macro - to each visible worksheet, and although it runs without errors this macro isn't working exactly as I intended. It is supposed to check each visible tab to see if there is already a Return to Index button, and if one isn't found, it should add one. It works on sheets where there has never been a Return to Index button; however, if button has been deleted, the macro runs as if the button were still on the sheet. I'd like some help figuring out how to fix this, so the button gets added to any sheet that doesn't currently have one.

Code:
Option Explicit
Sub Return_To_Index()

[COLOR=#008000]'Return from the active sheet to the corresponding cell on the index[/COLOR]

Dim tabname As String
Application.Volatile
tabname = ActiveSheet.Name

    Sheets("Index").Activate
    Cells.Find(What:=tabname, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select


End Sub

Sub Add_Return_To_Index_Button()

[COLOR=#008000]'This macro loops through each visible worksheet (except the Index sheet) and adds a Return to Index button[/COLOR]

Dim wSheet As Worksheet
Dim column_num As Long
Dim row_num As Long
Dim RtnButton As Shape
Dim Counter As Long
Dim Total As Long
    
[COLOR=#008000]'Turn off display alerts and screen updating, and turn on the status bar[/COLOR]
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
        
[COLOR=#008000]'Count the total number of visible worksheets in the workbook (excluding the index)[/COLOR]
    For Each wSheet In ThisWorkbook.Worksheets
        If wSheet.Visible = True And wSheet.Name <> "Index" Then
            Total = Total + 1
        End If
    Next wSheet

[COLOR=#008000]'Loop through each visible worksheet[/COLOR]
    For Each wSheet In ThisWorkbook.Worksheets
        [COLOR=#008000]' show the progress in the statusbar:[/COLOR]
        Application.StatusBar = "Adding return to index button to sheet " & Counter & _
            " of " & Total & "    " & Format((Counter / Total), "0%")
        
        If wSheet.Visible = xlSheetVisible And wSheet.Name <> "Index" Then
            wSheet.Activate
        
            [COLOR=#008000]'Check to see if a Return to Index button exists, and add it if it does not already exist[/COLOR]
                On Error Resume Next
                Set RtnButton = wSheet.Shapes("Return to Index Button")
                If RtnButton Is Nothing Then[COLOR=#ff0000]  '(Note: If there has ever been a Return to Index Button on a sheet, after it has been deleted the RtnButton is NOT Nothing, and the macro skips to End If rather than creating a new button... any help please??)[/COLOR]
                    [COLOR=#008000]'Identify the first visible column[/COLOR]
                        column_num = wSheet.UsedRange.SpecialCells(xlCellTypeVisible).Cells(1).Column
                            
                    [COLOR=#008000]'Identify the bottom row[/COLOR]
                        row_num = wSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2
                                
                    [COLOR=#008000]'Create the button (specify location, size, name, and assigned macro)[/COLOR]
                        wSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                            Cells(row_num, column_num).Left, _
                            Cells(row_num, column_num).Top, _
                            118.8, _
                            23.04).Select
                        Selection.Name = "Return to Index Button"
                        wSheet.Shapes("Return to Index Button").OnAction = "Return_To_Index"
                       
                   [COLOR=#008000] 'Format the button[/COLOR]
                        wSheet.Shapes("Return to Index Button").Select
                            Selection.ShapeRange.ShapeStyle = msoShapeStylePreset36
                            Selection.Characters.Text = "Return to the index"
                                With Selection.Characters(Start:=1, Length:=19).Font
                                    .Name = "Times New Roman"
                                    .FontStyle = "Bold Italic"
                                    .Size = 12
                                End With
                        Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
                End If
        End If
        Counter = Counter + 1
    Next wSheet
       
[COLOR=#008000]'Turn on display alerts and screen updating, and reset the status bar to ready[/COLOR]
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.StatusBar = False
       
End Sub
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
I'm kind of new to VBA, and pretty clumsy with it... I don't really write code, I just look up pieces here and there and patch it together. So I was looking this over, and thought why do this:

Code:
On Error Resume Next
Set RtnButton = wSheet.Shapes("Return to Index Button")
If RtnButton Is Nothing Then

Why not just do this:
Code:
If wSheet.Shapes("Return to Index Button") Is Nothing Then

So I tried, and guess what... I got an error.
It says Nothing = Nothing (which is what I was hoping for... If Nothing = Nothing Then make a button)... but it called it an error and stopped the macro for debugging.

That gave me this idea:

Code:
On Error Resume Next
If wSheet.Shapes("Return to Index Button") Is Nothing Then

And now it works! On sheets where the button has been deleted, the If Then line produces an error, so the On Error Resume Next line causes the If Then to be skipped and it moves to the next line and starts creating the button. I'm sure this is not the "right" way to do this, but it works! I'm so excited!!
 
Upvote 0

Forum statistics

Threads
1,223,632
Messages
6,173,472
Members
452,516
Latest member
archcalx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top