Error 1004 Select method from worksheet class failed

Hi,

I am a new member who is learning VBA and have been using Excel for many years. I am an Accountant/Operations Research modeller who loves Excel.


But, I am having trouble with Excel VBA code in a Table of Contents module. I get an error message "Select method from worksheet class failed."

I would appreciate if someone could advise me how to eliminate the error in the following code:

'This table of contents VBA code was created by Frank Wade on 31/10/2014:

Sub TOC()
' Declaring variables:
Dim wrk As Workbook
Dim sht As Worksheet 'i.e. the Table of Contents sheet
Dim shtTarget As Worksheet
Dim rng As Range
Dim intSheetNum As Integer
Dim intNumRows As Integer
Dim strSheetName As String
Dim lngRow As Long
Dim lngColumn As Long
Dim varSubaddress As Variant
Dim blnCreatTOC As Boolean
Dim SheetName As String 'SheetName is a string used in the code to add the TOC hyperlink on each sheet

On Error Resume Next

Set wrk = ActiveWorkbook

If wrk.ProtectStructure = True Then
MsgBox "You must unprotect the workbook " & "before running this procedure."
Else
blnCreateTOC = True
Set sht = wrk.Worksheets("Table of Contents")
If Err = 0 Then
If MsgBox("Table of Contents already exists." & " Delete it and create a new one?", _
vbYesNo, "Sheet Exists") = vbYes Then

On Error GoTo Err_Handler
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Else
blnCreateTOC = False
End If
End If
End If

On Error GoTo Err_Handler
If blnCreateTOC Then

intNumRows = InputBox("How many blank rows should " & "separate links?", "Blank Rows", 1) 'i.e. the default is 1 row

Application.ScreenUpdating = False
Set sht = wrk.Worksheets.Add(wrk.Sheets(1))
With sht
.Name = "Table of Contents"
.Columns(1).ColumnWidth = 2
.Range("B2") = "TABLE OF CONTENTS (TOC)"
.Range("B2").Font.Bold = True ' to bold the text font
.Range("B2").Font.Color = RGB(255, 255, 255) ' white font colour
.Range("B2").Interior.Color = RGB(0, 0, 0) ' black background colour
.Range("B2:H2").MergeCells = True ' true means yes to merge the cells
.Range("B2:H2").HorizontalAlignment = xlCenter
.Tab.Color = RGB(0, 0, 0) ' tab colour for the Table of Contents sheet is black background colou
.Range("B2:H2").BorderAround _
LineStyle = xlContinuous_
Weight = xlMedium_
ColorIndex = xlAutomatic

.Range("B3") = "To create a new TOC press Ctrl + Shift + T"
.Range("B3").Font.Italic = True
.Range("B3:H3").MergeCells = True ' true means yes to merge the cells
.Range("B3:H3").HorizontalAlignment = xlCenter

.Range("B4") = "Hidden sheets are shown in red text"
.Range("B4").Font.Italic = True
.Range("B4:H4").MergeCells = True ' true means yes to merge the cells
.Range("B4:H4").HorizontalAlignment = xlCenter

End With
'To set the number of rows between each hyperlink on the Table of Contents sheet
Set rng = sht.Range("B6") 'i.e. starting row to wrap columns
For intSheetNum = 2 To wrk.Worksheets.Count
If rng.Row > 24 Then 'i.e. wrap the column to the next column after the 24 row
lngRow = rng.Row
Set rng = rng.Offset(6 - lngRow, 2) ' i.e. start at row number 5 and wrap columns
lngColumn = rng.Column - 1
Columns(lngColumn).ColumnWidth = 2
End If

Set shtTarget = wrk.Worksheets(intSheetNum)
strSheetName = shtTarget.Name
varSubaddress = "'" & strSheetName & "'!A1"

rng.NumberFormat = "General"
rng.HorizontalAlignment = xlLeft
rng.Value = strSheetName
rng.Hyperlinks.Add Anchor:=rng, Address:="", _
SubAddress:=varSubaddress, ScreenTip:="Click to go to worksheet"

'Show hidden worksheets in red font text:
'The following code created a "Select method worksheet class failed" error message 1004:
With rng
If wrk.Sheets(strSheetName).Visible = xlSheetHidden Then
rng.Hyperlinks.Add Anchor:=rng, Address:="", _
SubAddress:=varSubaddress, ScreenTip:="Unhide worksheet"
rng.Font.Color = RGB(255, 0, 0) ' red background colour
End If
End With

Set rng = rng.Offset(intNumRows + 1, 0)
Columns(rng.Column).EntireColumn.AutoFit

Next intSheetNum

sht.Range("B2").Select
ActiveWindow.DisplayGridlines = False 'to turn off the gridlines on the Table of Contents sheet
Application.ScreenUpdating = True
End If

' Add a TOC hyperlink to cell A1 in each sheet
Application.ScreenUpdating = False
Sheets(2).Activate
For i = 2 To Sheets.Count
Sheets(i).Select (False)

Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(1), Address:="", SubAddress:= _
"'Table of Contents'!A1", TextToDisplay:="TOC", ScreenTip:="Click to go to Table of Contents"
Next

'Exit the procedure:
Exit_Proc:
Set rng = Nothing
Set sht = Nothing
Set shtTarget = Nothing
Set wrk = Nothing
Exit Sub

Err_Handler:
MsgBox Err & ": " & Err.Description
Resume Exit_Proc
End Sub

Hello FrankWade,

Welcome to Excelforum. Be a part of large Excel community. Enjoy Learning.