Trying to create table of contents with hyperlinks, but Hyperlinking formula not working - please help!

[BaZ_2020]

Hi MrExcel,

This site has been so useful in the past, but for some reason I can't find the solution to what I am looking for today.
I have 95% built what I want, but the hyperlinking of cells is just not working for me. Perhaps you can help, please? The troublesome part of my code is highlighted in red below

Essentially, what I am trying to do is to create a table of contents on a sheet called "Index"
- Source data is rest of workbook, sheets 6 to 12 and specifically the below

So, let's say that I am looking at Sheet6, and I am always interested in looking from cell A2 and below. If a cell is blank, I want to offset by one row.
If the cell is not blank, I want to create a hyperlink on the sheet called Index in cell B9 and below so that...

- The value of cell B9 on index sheet is the same as the value of that cell on its individual tab (ie Index sheet, cell B9 = (Sheet6,Cell A2) if that cell, A2, is not blank.
- Hyperlink Index sheet, cell B9 to Sheet6, cell A2.

And so forth until row 50, and then repeat for the remainder of the sheets.

I am happy with the VBA code I have so far (which will need some final tweaks to allow for the full range of data), but I can't get the hyperlinking bit to work.
- this is under the header of 'Hyperlinking magic' in the below.

As FYI,
- RowNumIndexSheet refers to the row number of reference on Index Sheet
- RowNumQnrSheet refers to the row number of reference on other Sheets of interest
- i, j and k are normal counters

----------------
Sub Create_Hyperlinks()

Dim i, j, k, RowNumIndexSheet, RowNumQnrSheet As Integer

' **Start from Sheet 4, the first sheet which has survey questions**

' i = number of sheets in workbook
i = 0
j = 0
k = 0

' Change INITIAL row number of index or questionnaire sheet below
RowNumIndexSheet = 9
RowNumQnrSheet = 3

For i = 4 To ActiveWorkbook.Sheets.Count

For k = RowNumQnrSheet To 4
Sheets(i).Select
Cells(RowNumQnrSheet, 1).Select

If Sheets(i).Range("A" & RowNumQnrSheet).Value = "" Then
ActiveCell.Offset(1, 0).Select
End If

If Sheets(i).Range("A" & RowNumQnrSheet).Value <> "" Then

Sheets("Index").Select
Cells(RowNumIndexSheet, 1).Select
Sheets("Index").Range("A" & RowNumIndexSheet).Value = Sheets(i).Name
'Sheets("Index").Range("B" & RowNumIndexSheet).Value = Sheets(i).Range("A" & RowNumQnrSheet).Value

'Hyperlinking magic
Sheets("Index").Range("B" & RowNumIndexSheet).Select

ActiveCell.hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="" & Sheets(i).Name & "!" & Range(1, RowNumQnrSheet) & "", ScreenTip:="", TextToDisplay:=Sheets(i).Range("A" & RowNumQnrSheet).Value

RowNumIndexSheet = RowNumIndexSheet + 1
End If

Next k
RowNumIndexSheet = RowNumIndexSheet + 1

Next i

End Sub

 

[6StringJazzer]

I can't get the hyperlinking bit to work.

What is happening instead of what you want to happen?

 

[BaZ_2020]

Hi @6StringJazzer

The cell is being populated by the text I want, but the actual hyperlink part is not working, so the subaddress part of the hyperlinking statement is the problem.

I believe it has to do with the way I am referring to the cell I want it to hyperlink to but no matter whether I use Range or Cells I can't get the hyperlink to be generated.

I can find formulas with constant cell ranges and the hyperlinks work fine but not one with variable cells

 

[Fluff]

Try

ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="'" & Sheets(i).Name & "'!" & Range("A" & RowNumQnrSheet), ScreenTip:="", TextToDisplay:=Sheets(i).Range("A" & RowNumQnrSheet).Value

 

[BaZ_2020]

Hi @Fluff

Have now tried this, but the hyperlink does not get created properly.

Macro runs, but if I click on one of the hyperlinks to test if it has worked, I get below error message

 

[Fluff]

How about

ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="'" & Sheets(i).Name & "'!" & Sheets(i).Range("A" & RowNumQnrSheet).Address, ScreenTip:="", TextToDisplay:=Sheets(i).Range("A" & RowNumQnrSheet).Value

 

[BaZ_2020]

@Fluff

Amazing, Thank you !! That works perfectly

 

[Fluff]

You're welcome & thanks for the feedback