Active cell as a reference to open a worksheet
Hello,
Is there a way to use an active cell to jump to another worksheet, I.E, Ive got a sheet with 53 cells with week commecing dates, ive also got 53 sheets named wk1 to wk53, I would a index sheet to use to jump to the required wk? sheet. Thanks for any help. |
Active cell as a reference to open a worksheet
InsertHyperlinkPlace In This Document...
-- HTH, Gary Brown If this post was helpful to you, please select ''YES'' at the bottom of the post. "LaDdIe" wrote: Hello, Is there a way to use an active cell to jump to another worksheet, I.E, Ive got a sheet with 53 cells with week commecing dates, ive also got 53 sheets named wk1 to wk53, I would a index sheet to use to jump to the required wk? sheet. Thanks for any help. |
Active cell as a reference to open a worksheet
As an alternative to Hyperlinks you could use code and a button you could place
on a Toolbar so it is available for every sheet. Here is macro from Bob Phillips that pops up a list of sheets to choose from. Sub BrowseSheets() Const nPerColumn As Long = 38 'number of items per column Const nWidth As Long = 13 'width of each letter Const nHeight As Long = 18 'height of each row Const sID As String = "___SheetGoto" 'name of dialog sheet Const kCaption As String = " Select sheet to goto" 'dialog caption Dim i As Long Dim TopPos As Long Dim iBooks As Long Dim cCols As Long Dim cLetters As Long Dim cMaxLetters As Long Dim cLeft As Long Dim thisDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As OptionButton Application.ScreenUpdating = False If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.DialogSheets(sID).Delete Application.DisplayAlerts = True On Error GoTo 0 Set CurrentSheet = ActiveSheet Set thisDlg = ActiveWorkbook.DialogSheets.Add With thisDlg .Name = sID .Visible = xlSheetHidden 'sets variables for positioning on dialog iBooks = 0 cCols = 0 cMaxLetters = 0 cLeft = 78 TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count If i Mod nPerColumn = 1 Then cCols = cCols + 1 TopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If Set CurrentSheet = ActiveWorkbook.Worksheets(i) cLetters = Len(CurrentSheet.Name) If cLetters cMaxLetters Then cMaxLetters = cLetters End If iBooks = iBooks + 1 .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5 .OptionButtons(iBooks).text = _ ActiveWorkbook.Worksheets(iBooks).Name TopPos = TopPos + 13 Next i .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24 CurrentSheet.Activate With .DialogFrame .Height = Application.Max(68, _ Application.Min(iBooks, nPerColumn) * nHeight + 10) .Width = cLeft + (cMaxLetters * nWidth) + 24 .Caption = kCaption End With .Buttons("Button 2").BringToFront .Buttons("Button 3").BringToFront Application.ScreenUpdating = True If .Show Then For Each cb In thisDlg.OptionButtons If cb.Value = xlOn Then ActiveWorkbook.Worksheets(cb.Caption).Select Exit For End If Next cb Else MsgBox "Nothing selected" End If Application.DisplayAlerts = False .Delete End With End Sub Gord Dibben MS Excel MVP On Fri, 9 Mar 2007 12:08:08 -0800, LaDdIe wrote: Hello, Is there a way to use an active cell to jump to another worksheet, I.E, Ive got a sheet with 53 cells with week commecing dates, ive also got 53 sheets named wk1 to wk53, I would a index sheet to use to jump to the required wk? sheet. Thanks for any help. |
Active cell as a reference to open a worksheet
Thanks Gary.
"Gary Brown" wrote: InsertHyperlinkPlace In This Document... -- HTH, Gary Brown If this post was helpful to you, please select ''YES'' at the bottom of the post. "LaDdIe" wrote: Hello, Is there a way to use an active cell to jump to another worksheet, I.E, Ive got a sheet with 53 cells with week commecing dates, ive also got 53 sheets named wk1 to wk53, I would a index sheet to use to jump to the required wk? sheet. Thanks for any help. |
Active cell as a reference to open a worksheet
COOOOOOOOL,
Thanks Gord "Gord Dibben" wrote: As an alternative to Hyperlinks you could use code and a button you could place on a Toolbar so it is available for every sheet. Here is macro from Bob Phillips that pops up a list of sheets to choose from. Sub BrowseSheets() Const nPerColumn As Long = 38 'number of items per column Const nWidth As Long = 13 'width of each letter Const nHeight As Long = 18 'height of each row Const sID As String = "___SheetGoto" 'name of dialog sheet Const kCaption As String = " Select sheet to goto" 'dialog caption Dim i As Long Dim TopPos As Long Dim iBooks As Long Dim cCols As Long Dim cLetters As Long Dim cMaxLetters As Long Dim cLeft As Long Dim thisDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As OptionButton Application.ScreenUpdating = False If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.DialogSheets(sID).Delete Application.DisplayAlerts = True On Error GoTo 0 Set CurrentSheet = ActiveSheet Set thisDlg = ActiveWorkbook.DialogSheets.Add With thisDlg .Name = sID .Visible = xlSheetHidden 'sets variables for positioning on dialog iBooks = 0 cCols = 0 cMaxLetters = 0 cLeft = 78 TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count If i Mod nPerColumn = 1 Then cCols = cCols + 1 TopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If Set CurrentSheet = ActiveWorkbook.Worksheets(i) cLetters = Len(CurrentSheet.Name) If cLetters cMaxLetters Then cMaxLetters = cLetters End If iBooks = iBooks + 1 .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5 .OptionButtons(iBooks).text = _ ActiveWorkbook.Worksheets(iBooks).Name TopPos = TopPos + 13 Next i .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24 CurrentSheet.Activate With .DialogFrame .Height = Application.Max(68, _ Application.Min(iBooks, nPerColumn) * nHeight + 10) .Width = cLeft + (cMaxLetters * nWidth) + 24 .Caption = kCaption End With .Buttons("Button 2").BringToFront .Buttons("Button 3").BringToFront Application.ScreenUpdating = True If .Show Then For Each cb In thisDlg.OptionButtons If cb.Value = xlOn Then ActiveWorkbook.Worksheets(cb.Caption).Select Exit For End If Next cb Else MsgBox "Nothing selected" End If Application.DisplayAlerts = False .Delete End With End Sub Gord Dibben MS Excel MVP On Fri, 9 Mar 2007 12:08:08 -0800, LaDdIe wrote: Hello, Is there a way to use an active cell to jump to another worksheet, I.E, Ive got a sheet with 53 cells with week commecing dates, ive also got 53 sheets named wk1 to wk53, I would a index sheet to use to jump to the required wk? sheet. Thanks for any help. |
Active cell as a reference to open a worksheet
Gordon,
I LOVED that code. I've updated it for protected workbooks, calling the macro from a chart and taking into account hidden worksheets. Hope you don't mind. Sincerely, Gary Brown '/=========================================/ ' Sub Purpose: a reference to open a worksheet 'From Discussion Group: Excel Worksheet Functions 'Date: 3/9/2007 2:53 PM PST 'From: Gord Dibben MS Excel MVP 'You could use code and a button you could place 'on a Toolbar so it is available for every sheet. 'Uses DIALOG SHEET. 'Here is macro from Bob Phillips that pops up a list of ' sheets to choose from. 'Revised by Gary Brown ' Sub Worksheet_GoTo() Const nPerColumn As Long = 30 'number of items per column Const nWidth As Long = 8 'width of each letter Const nHeight As Long = 18 'height of each row Const kCaption As String = _ " Select sheet to goto" 'dialog caption Const sID As String = "___SheetGoto" 'name of dialog sheet Dim blnDisplayAlerts As Boolean Dim blnScreenUpdating As Boolean Dim thisDlg As DialogSheet Dim i As Long Dim iTopPos As Long Dim iBooks As Long Dim cCols As Long Dim cLetters As Long Dim cMaxLetters As Long Dim cLeft As Long Dim cb As OptionButton Dim strCurrentWorkbook As String Dim strCurrentWorksheet As String Dim strDialogWkbk As String Dim wksCurrentSheet As Worksheet blnScreenUpdating = Application.ScreenUpdating 'check for an active workbook If ActiveWorkbook Is Nothing Then 'no workbooks open, so create one MsgBox "A Workbook is not open.", vbCritical + vbOKOnly, "Error..." GoTo exit_Sub End If strCurrentWorkbook = Application.ActiveWorkbook.name Application.ScreenUpdating = False blnDisplayAlerts = Application.DisplayAlerts ' If ActiveWorkbook.ProtectStructure Then ' MsgBox "Workbook is protected.", vbCritical ' Exit Sub ' End If On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.DialogSheets(sID).Delete Application.DisplayAlerts = True On Error GoTo 0 If ActiveSheet.Type = -4167 Then Set wksCurrentSheet = ActiveSheet Else Set wksCurrentSheet = Worksheets(1) End If If wksCurrentSheet Is Nothing Then GoTo err_Sub End If strCurrentWorksheet = wksCurrentSheet.name Workbooks.Add strDialogWkbk = ActiveWorkbook.name Set thisDlg = ActiveWorkbook.DialogSheets.Add With thisDlg .name = sID '.Visible = xlSheetHidden 'sets variables for positioning on dialog iBooks = 0 cCols = 0 cMaxLetters = 0 cLeft = 78 iTopPos = 40 Application.Workbooks(strCurrentWorkbook).Activate For i = 1 To ActiveWorkbook.Worksheets.Count If ActiveWorkbook.Worksheets(i).Visible = xlSheetVisible Then If i Mod nPerColumn = 1 Then cCols = cCols + 1 iTopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If Set wksCurrentSheet = ActiveWorkbook.Worksheets(i) cLetters = Len(wksCurrentSheet.name) If cLetters cMaxLetters Then cMaxLetters = cLetters End If iBooks = iBooks + 1 '.OptionButtons.Add cLeft, iTopPos, cLetters * nWidth, 16.5 .OptionButtons.Add cLeft, iTopPos, cLetters * nWidth, _ nHeight .OptionButtons(iBooks).Text = _ ActiveWorkbook.Worksheets(i).name If strCurrentWorksheet = .OptionButtons(iBooks).Text Then .OptionButtons(iBooks).value = xlOn End If iTopPos = iTopPos + 13 End If Next i .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24 wksCurrentSheet.Activate Application.Worksheets(strCurrentWorksheet).Activa te With .DialogFrame .Height = Application.Max(68, _ Application.Min(iBooks, nPerColumn) * nHeight + 10) '.Height = Application.Min(iBooks, nPerColumn) * _ (nHeight - 4) + 10 .Width = cLeft + (cMaxLetters * nWidth) + 24 .Caption = kCaption End With .Buttons("Button 2").BringToFront .Buttons("Button 3").BringToFront Application.ScreenUpdating = True If .Show Then For Each cb In thisDlg.OptionButtons If cb.value = xlOn Then ActiveWorkbook.Worksheets(cb.Caption).Select Exit For End If Next cb Else MsgBox "Nothing selected" End If Application.DisplayAlerts = False ' .Delete End With exit_Sub: On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Workbooks(strDialogWkbk).Activate Set wksCurrentSheet = Nothing Set thisDlg = Nothing ActiveWindow.Close Application.Workbooks(strCurrentWorkbook).Activate Application.ScreenUpdating = blnScreenUpdating Application.DisplayAlerts = blnDisplayAlerts Exit Sub err_Sub: Debug.Print "Error: " & Err.Number & " - (" & _ Err.Description & _ ") - Sub: BrowseSheets - " & _ "Module: Mod_Worksheet_List - " & Now() MsgBox "An error has occured." & vbCr & vbCr & _ "Error: " & Err.Number & " - " & Err.Description GoTo exit_Sub End Sub '/=========================================/ |
Active cell as a reference to open a worksheet
Gary
It is Bob's code but I'm sure he won't mind since we have given him initial attribution. I have copied your revised code. Thank you. Gord On Thu, 15 Mar 2007 06:26:00 -0700, Gary Brown wrote: Gordon, I LOVED that code. I've updated it for protected workbooks, calling the macro from a chart and taking into account hidden worksheets. Hope you don't mind. Sincerely, Gary Brown '/=========================================/ ' Sub Purpose: a reference to open a worksheet 'From Discussion Group: Excel Worksheet Functions 'Date: 3/9/2007 2:53 PM PST 'From: Gord Dibben MS Excel MVP 'You could use code and a button you could place 'on a Toolbar so it is available for every sheet. 'Uses DIALOG SHEET. 'Here is macro from Bob Phillips that pops up a list of ' sheets to choose from. 'Revised by Gary Brown ' Sub Worksheet_GoTo() Const nPerColumn As Long = 30 'number of items per column Const nWidth As Long = 8 'width of each letter Const nHeight As Long = 18 'height of each row Const kCaption As String = _ " Select sheet to goto" 'dialog caption Const sID As String = "___SheetGoto" 'name of dialog sheet Dim blnDisplayAlerts As Boolean Dim blnScreenUpdating As Boolean Dim thisDlg As DialogSheet Dim i As Long Dim iTopPos As Long Dim iBooks As Long Dim cCols As Long Dim cLetters As Long Dim cMaxLetters As Long Dim cLeft As Long Dim cb As OptionButton Dim strCurrentWorkbook As String Dim strCurrentWorksheet As String Dim strDialogWkbk As String Dim wksCurrentSheet As Worksheet blnScreenUpdating = Application.ScreenUpdating 'check for an active workbook If ActiveWorkbook Is Nothing Then 'no workbooks open, so create one MsgBox "A Workbook is not open.", vbCritical + vbOKOnly, "Error..." GoTo exit_Sub End If strCurrentWorkbook = Application.ActiveWorkbook.name Application.ScreenUpdating = False blnDisplayAlerts = Application.DisplayAlerts ' If ActiveWorkbook.ProtectStructure Then ' MsgBox "Workbook is protected.", vbCritical ' Exit Sub ' End If On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.DialogSheets(sID).Delete Application.DisplayAlerts = True On Error GoTo 0 If ActiveSheet.Type = -4167 Then Set wksCurrentSheet = ActiveSheet Else Set wksCurrentSheet = Worksheets(1) End If If wksCurrentSheet Is Nothing Then GoTo err_Sub End If strCurrentWorksheet = wksCurrentSheet.name Workbooks.Add strDialogWkbk = ActiveWorkbook.name Set thisDlg = ActiveWorkbook.DialogSheets.Add With thisDlg .name = sID '.Visible = xlSheetHidden 'sets variables for positioning on dialog iBooks = 0 cCols = 0 cMaxLetters = 0 cLeft = 78 iTopPos = 40 Application.Workbooks(strCurrentWorkbook).Activate For i = 1 To ActiveWorkbook.Worksheets.Count If ActiveWorkbook.Worksheets(i).Visible = xlSheetVisible Then If i Mod nPerColumn = 1 Then cCols = cCols + 1 iTopPos = 40 cLeft = cLeft + (cMaxLetters * nWidth) cMaxLetters = 0 End If Set wksCurrentSheet = ActiveWorkbook.Worksheets(i) cLetters = Len(wksCurrentSheet.name) If cLetters cMaxLetters Then cMaxLetters = cLetters End If iBooks = iBooks + 1 '.OptionButtons.Add cLeft, iTopPos, cLetters * nWidth, 16.5 .OptionButtons.Add cLeft, iTopPos, cLetters * nWidth, _ nHeight .OptionButtons(iBooks).Text = _ ActiveWorkbook.Worksheets(i).name If strCurrentWorksheet = .OptionButtons(iBooks).Text Then .OptionButtons(iBooks).value = xlOn End If iTopPos = iTopPos + 13 End If Next i .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24 wksCurrentSheet.Activate Application.Worksheets(strCurrentWorksheet).Activa te With .DialogFrame .Height = Application.Max(68, _ Application.Min(iBooks, nPerColumn) * nHeight + 10) '.Height = Application.Min(iBooks, nPerColumn) * _ (nHeight - 4) + 10 .Width = cLeft + (cMaxLetters * nWidth) + 24 .Caption = kCaption End With .Buttons("Button 2").BringToFront .Buttons("Button 3").BringToFront Application.ScreenUpdating = True If .Show Then For Each cb In thisDlg.OptionButtons If cb.value = xlOn Then ActiveWorkbook.Worksheets(cb.Caption).Select Exit For End If Next cb Else MsgBox "Nothing selected" End If Application.DisplayAlerts = False ' .Delete End With exit_Sub: On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Workbooks(strDialogWkbk).Activate Set wksCurrentSheet = Nothing Set thisDlg = Nothing ActiveWindow.Close Application.Workbooks(strCurrentWorkbook).Activate Application.ScreenUpdating = blnScreenUpdating Application.DisplayAlerts = blnDisplayAlerts Exit Sub err_Sub: Debug.Print "Error: " & Err.Number & " - (" & _ Err.Description & _ ") - Sub: BrowseSheets - " & _ "Module: Mod_Worksheet_List - " & Now() MsgBox "An error has occured." & vbCr & vbCr & _ "Error: " & Err.Number & " - " & Err.Description GoTo exit_Sub End Sub '/=========================================/ |
All times are GMT +1. The time now is 03:55 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com