Hyperlink to hidden sheet using a cell with the =Hyperlink formula

[pauldonnelly16]

Hi,

Hoping that someone can help with a hyperlink / VBA problem that's driving me crazy!?

Basically, I have a workbook with a front sheet which contains a column of hyperlinks to other sheets within the same workbook. Each of these hyperlinks is built using the =HYPERLINK formula rather than a right-click>Link type hyperlink. I had to build the hyperlinks using the formula method as various preceding columns are concatenated in order to build the name of the sheet which requires linking to.

So, with all sheets in the workbook unhidden, the formulated hyperlinks work perfectly. I can use them to jump to the relevant sheets with no problems. However, to tidy up the workbook, I want to be able to hide all of the individual sheets except for the front sheet - and then when I click on a hyperlink, only the relevant sheet would be unhidden for editing & then re-hidden once a 'Back' button is pressed. I just can't get the hyperlinks to work once the individual sheets are hidden - clicking the links does nothing, and I can't figure out why or how to fix it?

I've done something similar in the past using the sheet code below - but this one only seems to work using 'normal' hyperlinks. I'm guessing it's not working for me now because i'm using the =HYPERLINK formula? If so, anyone any ideas how I can get around this and achieve what I'm trying to do? Apologies if this has been answered before, I had a search but couldn't find anything.

Cheers,
Paul

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim strSheet As String
    strSheet = Left(Target.SubAddress, InStr(1, Target.SubAddress, "!") - 1)
    If Left(strSheet, 1) = "'" Then
        strSheet = Mid(strSheet, 2, Len(strSheet) - 2)
    End If
    Worksheets(strSheet).Visible = xlSheetVisible
    Application.EnableEvents = False
    Target.Follow
    Application.EnableEvents = True
 End Sub</code>

 

[Jaafar Tribak]

Give this a try :

Workbook example.

Code assumes that the cells with the Hyperlink formulaes are in Coulumn A .. Also, bear in mind the code works based on the Hyperlink freindly name text which should follow the same pattern for each hyperlink... Download the workbook example from the above link to see what I mean.


- Add the code to the ThisWorkbook Module:

Option Explicit

Private WithEvents CmndBars As CommandBars

Private Type POINTAPI
    x As Long
    Y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare Function GetActiveWindow Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Sub Workbook_Activate()
    Set CmndBars = Application.CommandBars
    Call CmndBars_OnUpdate
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set CmndBars = Application.CommandBars
    Call CmndBars_OnUpdate
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set CmndBars = Nothing
End Sub

Private Sub CmndBars_OnUpdate()
    Static lPrev As Long
    Dim tCurPos As POINTAPI
    Dim oObj As Object, oTargetSheet As Worksheet
    Dim sFriendlyName As String, sTargetRangeAddr As String
 
    If Not ActiveWorkbook Is Me Or GetActiveWindow <> Application.Hwnd Then Exit Sub
    
    With Application
        .CommandBars.FindControl(ID:=2020).Enabled = Not .CommandBars.FindControl(ID:=2020).Enabled
        GetCursorPos tCurPos
        Set oObj = .ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.Y)
        If TypeName(oObj) = "Range" Then
            If oObj.Column = 1 Then
                If InStr(1, oObj.Formula, "=HYPERLINK") Then
                    If lPrev <> GetKeyState(VBA.vbKeyLButton) Then
                        sFriendlyName = Evaluate(oObj.Formula)
                        Set oTargetSheet = Worksheets(Left(Replace(sFriendlyName, "Go to ", ""), InStr(1, Replace(sFriendlyName, "Go to ", ""), "=") - 2))
                        sTargetRangeAddr = Right(sFriendlyName, Len(sFriendlyName) - InStr(1, sFriendlyName, ">") - 1)
                        If oTargetSheet.Visible <> xlSheetVisible Then
                            oTargetSheet.Visible = xlSheetVisible
                            Application.Goto oTargetSheet.Range(sTargetRangeAddr), True
                            MsgBox sFriendlyName  [B][COLOR=#006400]' <== Remove this MsgBox line if you want.[/COLOR][/B]
                        End If
                    End If
                End If
            End If
        End If
    End With
    lPrev = GetKeyState(VBA.vbKeyLButton)
End Sub

Public Sub HideAllSheets()
    Dim oWs As Worksheet
    For Each oWs In Me.Worksheets
        If UCase(oWs.Name) <> UCase("Front Sheet") Then
            oWs.Visible = xlSheetVeryHidden
        End If
    Next oWs
End Sub

 

[pauldonnelly16]

Have just got round to trying your code, and once customised to suit my workbook, it works an absolute dream! Thanks very much!!

 

[Jaafar Tribak]

Have just got round to trying your code, and once customised to suit my workbook, it works an absolute dream! Thanks very much!!

Thank you Sir for the feedback and glad I could help.

 

[babyjb]

Give this a try :

Workbook example.

Code assumes that the cells with the Hyperlink formulaes are in Coulumn A .. Also, bear in mind the code works based on the Hyperlink freindly name text which should follow the same pattern for each hyperlink... Download the workbook example from the above link to see what I mean.


- Add the code to the ThisWorkbook Module:

Option Explicit

Private WithEvents CmndBars As CommandBars

Private Type POINTAPI
    x As Long
    Y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare Function GetActiveWindow Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Sub Workbook_Activate()
    Set CmndBars = Application.CommandBars
    Call CmndBars_OnUpdate
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set CmndBars = Application.CommandBars
    Call CmndBars_OnUpdate
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set CmndBars = Nothing
End Sub

Private Sub CmndBars_OnUpdate()
    Static lPrev As Long
    Dim tCurPos As POINTAPI
    Dim oObj As Object, oTargetSheet As Worksheet
    Dim sFriendlyName As String, sTargetRangeAddr As String
 
    If Not ActiveWorkbook Is Me Or GetActiveWindow <> Application.Hwnd Then Exit Sub
   
    With Application
        .CommandBars.FindControl(ID:=2020).Enabled = Not .CommandBars.FindControl(ID:=2020).Enabled
        GetCursorPos tCurPos
        Set oObj = .ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.Y)
        If TypeName(oObj) = "Range" Then
            If oObj.Column = 1 Then
                If InStr(1, oObj.Formula, "=HYPERLINK") Then
                    If lPrev <> GetKeyState(VBA.vbKeyLButton) Then
                        sFriendlyName = Evaluate(oObj.Formula)
                        Set oTargetSheet = Worksheets(Left(Replace(sFriendlyName, "Go to ", ""), InStr(1, Replace(sFriendlyName, "Go to ", ""), "=") - 2))
                        sTargetRangeAddr = Right(sFriendlyName, Len(sFriendlyName) - InStr(1, sFriendlyName, ">") - 1)
                        If oTargetSheet.Visible <> xlSheetVisible Then
                            oTargetSheet.Visible = xlSheetVisible
                            Application.Goto oTargetSheet.Range(sTargetRangeAddr), True
                            MsgBox sFriendlyName  [B][COLOR=#006400]' <== Remove this MsgBox line if you want.[/COLOR][/B]
                        End If
                    End If
                End If
            End If
        End If
    End With
    lPrev = GetKeyState(VBA.vbKeyLButton)
End Sub

Public Sub HideAllSheets()
    Dim oWs As Worksheet
    For Each oWs In Me.Worksheets
        If UCase(oWs.Name) <> UCase("Front Sheet") Then
            oWs.Visible = xlSheetVeryHidden
        End If
    Next oWs
End Sub

Hi, where should I paste this code? in the view code of Main sheet or the sheets I want to hide?

 

[Jaafar Tribak]

Hi, where should I paste this code? in the view code of Main sheet or the sheets I want to hide?

Try this code instead : open hidden sheet with dynamic hyperlink


The code goes in the ThisWorkbook Module

 

[babyjb]

Try this code instead : open hidden sheet with dynamic hyperlink


The code goes in the ThisWorkbook ModuleView attachment 59773

Thank you!