Extend a VBA macro with a hyperlinks table

[excelactuary]

Hello!

I want to add following functionality to a vba macro. The program collects data from different sheets and writes it into a single sheet. The layout is like this:

Blank row

Cell A2 - Title for the upcoming block
Cells A3:L16 - Data block

Blank row

Cell A18 Title
Cells A19:L55 - Data block

Blank row

etc.

In total, I have 12 data blocks with titles. There is always a blank line between the data blocks. Now, I want to add hyperlinks to the title cells A2, A18 etc. These hyperlinks should be in the cells N10, N11, N12 and so on. Also, N10 should contain the text information in A2.
So: if A2 contains the text "Title1", I would want to have a hyperlink in N10 called "Title 1" and jump to A2 when clicking N10.

It would be great, if the macro would be handle a random number of data blocks, so that I wouldn't have to tell beforehand how many blocks I have.

Do you have any ideas how to do this? Thank you very much!

[Sintek]

Hi excelactuary

Any chance of a sample workbook depicting your requirement.

Edit: Not to worry, see if this is what you require:

Option Explicit

Sub Title_hyperLink()
Dim rngTo As Range, rngFrom As Range
Dim lRow As Long
Dim i As Integer, j As Integer
Dim LinkText As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
lRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    j = 10
    For i = 1 To lRow
        If Cells(i, 1).Value = "" Then
            Set rngFrom = ws.Cells(i, 1).Offset(1, 0)
            Set rngTo = ws.Cells(j, 14)
            LinkText = ws.Cells(i, 1).Offset(1, 0).Text
            rngFrom.Parent.Hyperlinks.Add Anchor:=rngTo, Address:="", _
            SubAddress:="'" & rngTo.Parent.Name & "'!" & rngFrom.Address(), _
            TextToDisplay:=LinkText
            j = j + 1
        End If
    Next i
End With
Application.ScreenUpdating = False
End Sub

[excelactuary]

Hello sintek!

Thank you so much, your code does exactly what I wanted. In the future, I will post a workbook sample.

One more question: if I want to add custom text in the cell N9, what would I add to the code?

Edit:

Got it:

Dim TxtRng  As Range
Set TxtRng = ws.Range("N9")
    TxtRng.Value = "Text"

[Sintek]

if I want to add custom text in the cell N9

...Don't you mean custom text in N10, N11 etc
If so change this line of code

LinkText = ws.Cells(i, 1).Offset(1, 0).Text

to

LinkText = "Add your Custom Text between these"

or do you just want to add a heading in N9.

[excelactuary]

I just want a heading in N9.

[Sintek]

add this line

Cells(9, 14) = "Add your Custom Text between these"

under

j = 10

Glad I could help. thanks for rep points.