Macro to GoTo or Create ws

[VegasNath]

Hello,
I am after a little help please.
I have a ws which has a column of numbers. Each number may or may not have a corresponding ws. I would like to double-click the number and either a: GoTo the corresponding sheet, or B: If the sheet does not exist, copy the 'Template' sheet to be the last sheet in the wb and name it accordingly.
I'm not really sure how to achieve this so any help appreciated.

[HansV]

Right-click the sheet tab and select View Code from the popup menu.

Copy the following code into the module window:

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim wsh As Worksheet
  If Not Intersect(Range("A2:A50"), Target) Is Nothing Then
    Application.EnableEvents = False
    Cancel = True
    On Error Resume Next
    Set wsh = Worksheets(CStr(Target.Value))
    On Error GoTo 0
    If wsh Is Nothing Then
      Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
      Set wsh = Worksheets(Worksheets.Count)
      wsh.Name = CStr(Target.Value)
    End If
    wsh.Select
    Application.EnableEvents = True
  End If
End Sub

Change the range A2:A50 to the range containing the numbers.

[VegasNath]

Many Thanks Hans, that's very helpful!

[VegasNath]

Hans,

I added the following code before wsh.select, but the double click does not work as a result. Any idea's?

Code: Select all

    If wsh.Visible <> xlSheetVisible Then
        wsh.Visible = xlSheetVisible
    End If

[HansV]

You probably got an error at some point, and as a result, Application.EnableEvents hasn't been set to True again, so Excel doesn't react to events any more.

Activate the Immediate window in the Visual Editor.
Type or paste the line

Application.EnableEvents = True

and press Enter.

Here is a version that will handle errors:

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim wsh As Worksheet
  If Not Intersect(Range("A2:A50"), Target) Is Nothing Then
    Application.EnableEvents = False
    Cancel = True
    On Error Resume Next
    Set wsh = Worksheets(CStr(Target.Value))
    On Error GoTo ErrHandler
    If wsh Is Nothing Then
      Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
      Set wsh = Worksheets(Worksheets.Count)
      wsh.Name = CStr(Target.Value)
    End If
    If wsh.Visible <> xlSheetVisible Then
      wsh.Visible = xlSheetVisible
    End If
    wsh.Select
  End If

ExitHandler:
  Application.EnableEvents = True
  Exit Sub

ErrHandler:
  MsgBox Err.Description
  Resume ExitHandler
End Sub

[VegasNath]

Thanks Hans. that is exactly what happened. Cheers for the update!

[VegasNath]

Hans, I am using the code above in the 'Index' sheet to go to various other sheets, the code is in the ws object. I want to use a double click event on all of the other sheets so I have put the following code in the 'ThisWorkbook' object.

Code: Select all

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  
    If Not Intersect(Range("I12:I16"), Target) Is Nothing Then
        Application.EnableEvents = False
        Cancel = True
        On Error GoTo ErrHandler
            'Code to hide rows
        Application.Goto Range("A1"), True
    End If

ExitHandler:
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

When I use your code above, this seems to be executing the ThisWorkbook event and providing an error "Method 'Intersect' of object '_Global' failed.

Can you see what I am doing wrong here?

[VegasNath]

I have solved this.

I was missing a 'Sh'....... If Not Intersect(Sh.Range("I12:I16"), Target) Is Nothing Then

Thanks

[VegasNath]

Is it possible to fire a different event based upon which of the cells was double clicked within the above range, or are 5 different code events required?

[VegasNath]

Update:
I'm not sure that this is the best / most efficient approach, so I would appreciate any feedback..

Code: Select all

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim LRow As Long
Dim Rng As Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Sh.Rows.Hidden = False
    
    LRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    If Not Intersect(Sh.Range("I12"), Target) Is Nothing Then
        Cancel = True
        On Error GoTo ErrHandler
        'Code to hide rows
            For Each Rng In Range("X29:X" & LRow)
                If Rng.Interior.ColorIndex <> Sh.Range("I12").Interior.ColorIndex Then
                    Rng.EntireRow.Hidden = True
                End If
            Next Rng
    End If
    
    If Not Intersect(Sh.Range("I13"), Target) Is Nothing Then
        Cancel = True
        On Error GoTo ErrHandler
        'Code to hide rows
            For Each Rng In Range("X29:X" & LRow)
                If Rng.Interior.ColorIndex <> Sh.Range("I13").Interior.ColorIndex Then
                    Rng.EntireRow.Hidden = True
                End If
            Next Rng
    End If
    
    If Not Intersect(Sh.Range("I14"), Target) Is Nothing Then
        Cancel = True
        On Error GoTo ErrHandler
        'Code to hide rows
            For Each Rng In Range("X29:X" & LRow)
                If Rng.Interior.ColorIndex <> Sh.Range("I14").Interior.ColorIndex Then
                    Rng.EntireRow.Hidden = True
                End If
            Next Rng
    End If

    If Not Intersect(Sh.Range("I15"), Target) Is Nothing Then
        Cancel = True
        On Error GoTo ErrHandler
        'Code to hide rows
            For Each Rng In Range("X29:X" & LRow)
                If Rng.Interior.ColorIndex <> Sh.Range("I15").Interior.ColorIndex Then
                    Rng.EntireRow.Hidden = True
                End If
            Next Rng
    End If

    If Not Intersect(Sh.Range("I16"), Target) Is Nothing Then
        Cancel = True
        On Error GoTo ErrHandler
        'Code to hide rows
            For Each Rng In Range("X29:X" & LRow)
                If Rng.Interior.ColorIndex <> Sh.Range("I16").Interior.ColorIndex Then
                    Rng.EntireRow.Hidden = True
                End If
            Next Rng
    End If
    
ExitHandler:
    Application.Goto Range("A1"), True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

[HansV]

You'd use only one event procedure but test which cell was double-clicked, for example:

Code: Select all

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Sh.Range("I12:I16"), Target) Is Nothing Then
        Application.EnableEvents = False
        Cancel = True
        On Error GoTo ErrHandler
        Select Case Target.Address
            Case "I12"
                ...
            Case "I13"
                ...
            Case "I14"
                ...
            Case "I15"
                ...
            Case "I16"
                ...
        End Select
        Application.Goto Sh.Range("A1"), True
    End If

ExitHandler:
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

[VegasNath]

Thanks Hans.