Auto hyperlink

Hi,

Let me see if i undesrtand:

You are in Sheet1

You have cell "Q21" selected.

You click the Generate button.

Sheet "ABC" is activated.

Or if cell "Q23" is selected and click Generate button, sheet "MNO" is activated.

Is that what you need?

Ok,

This code will create the hyperlinks.

You will have to select any cell on the row were you want create the hyperlink.

It only creates an hyperlink per click.

Place the code on the Button code

Private Sub CommandButton1_Click()

Dim htSheetaa As Range
Dim htSheetab As Range

htSheeta = Cells(ActiveCell.Row, 3).Text
htSheetb = Cells(ActiveCell.Row, 8).Text
Set htSheetaa = Cells(ActiveCell.Row, 17)
Set htSheetab = Cells(ActiveCell.Row, 20)

    ActiveSheet.Hyperlinks.Add Anchor:=htSheetaa, Address:="", SubAddress:= _
        " " & htSheeta & "!A1", TextToDisplay:=" " & htSheeta & " "
        
    ActiveSheet.Hyperlinks.Add Anchor:=htSheetab, Address:="", SubAddress:= _
        " " & htSheetb & "!A1", TextToDisplay:=" " & htSheetb & " "
   
End Sub

Let me know if its working or what improvements does it needs

Nuno Lopes

Hi,
Thanks for the code, but can you kindly modify the code a bit so that I dont have to click it every time after I enter a data.

I mean I click once and the links are created upto Q200 and T200.

It will also be great if I can have another button when clicked, that will clear the cells Q21 to Q200 and T21 to T200.

Thanks in advance.
me.

Hi,

I think that's ok now.

It will create all the hyperlinks

Place it on the Button code

Private Sub CommandButton1_Click()

Dim htSheetaa As Range
Dim htSheetab As Range
Dim lnInc As Integer

lnInc = 21

Application.ScreenUpdating = False

Do

htSheeta = Cells(lnInc, 3).Text
htSheetb = Cells(lnInc, 8).Text
Set htSheetaa = Cells(lnInc, 17)
Set htSheetab = Cells(lnInc, 20)

    If htSheeta <> "" Then
    ActiveSheet.Hyperlinks.Add Anchor:=htSheetaa, Address:="", SubAddress:= _
        " " & htSheeta & "!A1", TextToDisplay:=" " & htSheeta & " "
    End If
    
    If htSheetb <> "" Then
    ActiveSheet.Hyperlinks.Add Anchor:=htSheetab, Address:="", SubAddress:= _
        " " & htSheetb & "!A1", TextToDisplay:=" " & htSheetb & " "
    End If
    
    lnInc = lnInc + 1
    
Loop Until lnInc = 201

Application.ScreenUpdating = True

End Sub

This one will delete all the hypelinks.

Add a new button and place the code.

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Range("Q21:Q200").Select
Selection.ClearContents
Range("T21:T200").Select
Selection.ClearContents

Range("Q21").Select

Application.ScreenUpdating = True

End Sub

Let me know if it's everything ok

Hi Nlex,
There is a small problem .

it the data are like "S 12" or say "Scope A" the links are not working.
I mean if there is a space. the links are not working.

Can ypu please take a look at it. Clear button is perfect. No problem with that.
Thanks in advance.

Hi,

Do you really need to have the hyperlinks or you just want a way to "navigate" throug the sheets in the workbook?

Hi Nlex,
my main purpose is to jump to that sheet and paste the datas calculated in column O, P,R, S .
Now i have around 180 sheets with unique names.One for evey individual name.

now these names are defined column C and H. and some calculations are performed on column O,P,R,S.

So I need a link on Column Q and Column T, So that I can jump to that page. and paste the values.

That's all.

Ok,

I already had a similar problem.

I've solved it without the hyperlinks

I just select the cell that has the name of the sheet where i want to go and then click a button that has the following:

Private Sub CommandButton1_Click()
nmSheet = ActiveCell.Text
Sheets(nmSheet).Activate
End Sub

Two lines of code, the "same" result

Tell me if that is ok for you.

Hi Nlex,

I have modified the code you have posted and it worked like a charm.

    If htSheeta <> "" Then
    ActiveSheet.Hyperlinks.Add Anchor:=htSheetaa, Address:="", SubAddress:= _
        "'" & htSheeta & "'" & "!A1", TextToDisplay:=" " & htSheeta & " "
    End If
    
    If htSheetb <> "" Then
    ActiveSheet.Hyperlinks.Add Anchor:=htSheetab, Address:="", SubAddress:= _
        "'" & htSheetb & "'" & "!A1", TextToDisplay:=" " & htSheetb & " "
    End If

ALL THE CREDIT GOES TO YOU.

THANKS A TON.
I guess this post will help lot's of people.
Thanks Nlex for everything [:D]
I am marking this a solved.