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