Hyperlinks to a Worksheet within the same Workbook

[Chris Waller]

Hi, I am using Excel 2013 and I am experiencing a problem trying to create a number of Hyperlinks from two Worksheets to a third within the same Workbook.

In the Workbook there are three sheets. The first Worksheet is pretty constant whilst the other two change on a weekly basis. Worksheet 2 and 3 both contain approximately 800 rows of data. What I am trying to do is change column A on Worksheet 2 to hyperlinks to specific cells on Worksheet 1 (contains the same text) and column B on Worksheet 3 to specific cells on Worksheet 1 (contains the same text). I’d rather not spend the entire week doing this manually, so could someone tell me if this is possible using a macro/VBA? TIA

 

[Johnny C]

Easy enough.

This should give you an idea of how to do it. This doesn't solve your problem, it just hyperlinks to cell A1 in the sheet whose names are in the selected range

Sub AutoHyperLink()
For Each c In Selection
    linkID = c.Value
    If linkID = "" Then Exit Sub
    ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="'" & linkID & "'!A1", TextToDisplay:=linkID
Next c
End Sub

Anchor is the cell with the hyperlink in
SubAddress needs the sheet link reference in the usual format, Sheet!A1
So all you need to work out is the cell reference. To get it into A1 format use

Sheet(x).Name&"!"&Sheet(x).Cells([Row], [Column]).Address(True, True, xlA1)

where Sheet(x) is the sheet you're hyperlinking to

 

[jim may]

Try this on A NEW WORKBOOK that you should create (Not your live file)

The 3 Worksheets (Sheet1, Sheet2, Sheet3) should have a single header row - with your data starting on row 2 - I'm having TROUBLE with posting Sheet replicas into the Body of this sheet (Sorry)

A <tbody> </tbody> A <tbody> </tbody> <strike></strike>Excel 2010 A <tbody> </tbody>

<tbody>
</tbody>

Sub Foo()
Dim LR1 As Long, LR2 As Long, LR3 As Long, RCount As Long
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim W1 As Worksheet, W2 As Worksheet, W3 As Worksheet
Set W1 = Sheet1

LR1 = W1.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng1 =W1.Range("A2:A" & LR1)

'Perform Process on Sheet2

Set W2 = Sheet2
W2.Activate
Range("A1").Select
W2.Hyperlinks.Delete
RCount = 0
LR2 = W2.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng2 =W2.Range("A2:A" & LR2)
    For Each C In Rng2
    linkID = C.Value
    If linkID ="" Then Exit Sub
    On Error ResumeNext
    rFound =WorksheetFunction.Match(linkID, Rng1, 0)
        If rFound >0 Then
        RCount =RCount + 1
       ActiveSheet.Hyperlinks.Add Anchor:=C, Address:="", SubAddress:="Sheet1!"& "A" & RCount + 2, TextToDisplay:=linkID
        rFound = 0
        End If
    GotoError = 0
    Next C

'Perform Process on Sheet3

Set W3 = Sheet3
W3.Hyperlinks.Delete
RCount = 0
LR3 = W3.Range("B" & Rows.Count).End(xlUp).Row
    Set Rng3 =W3.Range("B2:B" & LR3)
    For Each C In Rng3
    linkID = C.Value
    If linkID ="" Then Exit Sub
    On Error ResumeNext
    rFound =WorksheetFunction.Match(linkID, Rng1, 0)
        If rFound >0 Then
        RCount =RCount + 1
        ActiveSheet.Hyperlinks.Add Anchor:=C,Address:="", SubAddress:="Sheet1!" & "A"& RCount + 2, TextToDisplay:=linkID
        rFound = 0
        End If
    GotoError = 0
    Next C

End Sub

 

[jim may]

Correction - in Both Instances of the Lines (that is 2 lines)...
the "+2" in each should be "+1".

So instead of:

ActiveSheet.Hyperlinks.Add Anchor:=C,Address:="", SubAddress:="Sheet1!" & "A"& RCount + 2​

, TextToDisplay:=linkID

both lines should read:
ActiveSheet.Hyperlinks.Add Anchor:=C,Address:="", SubAddress:="Sheet1!" & "A"& RCount + 1

, TextToDisplay:=linkID
_{^{<strike>
</strike>}}

 

[Chris Waller]

Jim,

Thanks for your response. I have tried to use your code above and it threw up an error at the On Error ResumeNext. I think the error was due to the lack of space between Resume and Next. Your code also managed to delete all the hyperlinks that were in sheet 2 and sheet 3, however it didn't put any hyperlinks into sheets 2 or 3 to reference the cells on sheet 1. The cells are in a different position, but the text in the cells is the same as on sheet 1. TIA.

 

[Chris Waller]

Johnny C. I have not quite managed to work your code out yet. I am not too eau fait with VBA, but I am trying. Some may say very trying. TIA

 

[jim may]

hanks for your response. I have tried to use your code above and it threw up an error at the On Error ResumeNext. I think the error was due to the lack of space between Resume and Next.

Yes, you are RIGHT.
​

Your code also managed to delete all the hyperlinks that were in sheet 2 and sheet 3,

The code is intended to do this. Each time to run the code it should be a total replacement of the hyperlinks in Sheet2 and Sheet3.

however it didn't put any hyperlinks into sheets 2 or 3 to reference the cells on sheet 1. The cells are in a different position,

Not sure what you mean by the underlined text. The code assumes your Sheet1 data is ONLY in Column A running contiguously (no blank rows) between cell A2 to A??? (the Last nonblank row in Column A).

Have you tried STEPPING Through the code - performing with the F8 Key to see exactly (step by step) what each line is doing?

Hope this Helps !!
​

 

[Chris Waller]

Jim,

Yes I have tried stepping through the code. It appears that the macro down to the line that contains Hyperlink.Delete works fine. All the subsequent lines do not appear to do anything no matter how often I run the macro. So the top and bottom of it is that I have greened out all the other lines and all appears to work. The only thing I have to do now is to create the links from sheet 2 and 3 to sheet 1. What I know at the moment is that the text that needs to become hyperlinks on sheets 2 and 3 appear on sheet1, but they are in different columns i.e. J4:T24. TIA

 

[jim may]

You said NOTHING about Columns J:T in your original statement, only Columns A (sheet1); Column A (sheet2) and Column B (sheet3).
Good luck hope my code (based on your original description of things) is of some value to you.
Jim