IE Style navigation for Excel

dvivek_aca
dvivek_aca used Ask the Experts™
on
Hi Experts,

I am trying to get a piece of code / solution that will be enable me to navigate back and forth  on a excel worksheet. To explain, Lets say i move from Sheet 1 to Sheet 5 and to Sheet 7. If i then click a 'back button' i should go to Sheet 5 and if i hit the button again i should go to Sheet 1.

The navigation should happen in the 'Active Workbook'. So if i flip to another workbook, then i should be able to move back and forth within it based on the sheets selection i had made in that workbook.

I am not sure if this is something impossible.. using the code below, i have been able to achieve 'going back' provided this code is put tn the sheet i am trying to navigate. But what i am looking at is a code that will go into my 'Personal Macro sheet'. Thereby i need not put this code in every workbook i open.

Thanks
Vivek
' For the Code to work, create a sheet called 'Hist' in the workbook
''Code that goes into ThisWorkbook area
Public Sh As String, sht As Worksheet, asht As Workbook, r As Integer
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set sht = ThisWorkbook.Sheets("hist")
    sht.Cells.ClearContents
End Sub
Private Sub Workbook_Open()
    Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
   r = sht.Cells(1, 2)
    If IsNull(r) Or r = 0 Then r = 1
    
    sht.Cells(r, 1) = asht.ActiveSheet.Name
    sht.Cells(r, 2) = r + 1
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
   r = sht.Cells(1, 2)
   sht.Cells(r, 1) = asht.ActiveSheet.Name
   sht.Cells(1, 2) = r + 1
End Sub
 
''Code that goes into Module1
Public Sh As String, sht As Worksheet, asht As Workbook, r As Integer
Sub go_back()
    Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
    r = sht.Cells(1, 2)
   r = r - 1
   If r <= 0 Then
        MsgBox "Reached last item in the history"
    Else
        s = sht.Cells(r, 1)
        asht.Sheets(s).Select
        sht.Cells(1, 2) = r
    End If
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
Commented:
I believe you would make more progress using a class module that traps Application events. This code would only need to go in your Personal.xls workbook, yet would retain a history of all worksheets visited in all open workbooks.

I modified your code so the hist worksheet records columns of data. Row 1 contains the workbook name, row 2 the current index number and rows 3 and beyond the names of the worksheets on that workbook.

The code in the attached workbook functions, but hasn't been tested thoroughly. I'm hoping it will give you enough to go on. If not, I'll revisit the question over lunch.

Brad
BackButtonQ24840760.xls
byundtMechanical Engineer
Most Valuable Expert 2013
Top Expert 2013

Commented:
I failed to copy the code into the comment, and am rectifying the matter in the snippet below.
'Code that must go in ThisWorkbook code pane. It won't work at all if installed anywhere else
Private xlApp As cExcelEvents

Private Sub Workbook_Open()
    Set xlApp = New cExcelEvents
End Sub


'Code that goes into Module1
Public sht As Worksheet, asht As Workbook, r As Integer, rWB As Integer
Sub go_back()
    Dim s As String
    Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
    rWB = sht.Rows(1).Find(asht.Name).Column
    r = sht.Cells(2, rWB)
    r = r - 1
    If r <= 0 Then
        MsgBox "Reached last item in the history"
    Else
        s = sht.Cells(r, rWB)
        asht.Sheets(s).Select
        sht.Cells(2, rWB) = r
    End If
End Sub


' For the Code to work, create a sheet called 'Hist' in the workbook. Row 1 is workbook name. Row 2 is stack index for that workbook.
'Code that goes into class module called cExcelEvents. This is not the default name, and must be set using the Properties pane!
Private WithEvents xlApp As Application
Public sh As String, sht As Worksheet, asht As Workbook, r As Integer
 
Private Sub Class_Initialize()
    Set xlApp = Application
End Sub

Private Sub xlapp_SheetDeactivate(ByVal sh As Object)
    Dim rWB As Integer
    Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
    On Error Resume Next
    rWB = sht.Rows(1).Find(asht.Name).Column
    On Error GoTo 0
    If rWB = 0 Then
        NewBook asht.ActiveSheet
        rWB = sht.Rows(1).Find(asht.Name).Column
    End If
    r = sht.Cells(2, rWB)
    If (r > 2) And (sht.Cells(r - 1, rWB) <> asht.ActiveSheet.Name) Then
        sht.Cells(r, rWB) = asht.ActiveSheet.Name
        sht.Cells(2, rWB) = r + 1
    End If
End Sub

Private Sub xlapp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    Dim rWB As Integer
    Set sht = ThisWorkbook.Sheets("hist")
    On Error Resume Next
    rWB = sht.Rows(1).Find(Wb.Name).Column
    On Error GoTo 0
    If rWB <> 0 Then sht.Columns(rWB).Delete
End Sub

Private Sub xlapp_WorkbookOpen(ByVal Wb As Workbook)
NewBook ActiveWorkbook.ActiveSheet
End Sub

Private Sub NewBook(sh As Worksheet)
    Dim rWB As Integer
    Set sht = ThisWorkbook.Sheets("hist")
    Set asht = ActiveWorkbook
    rWB = sht.Cells(1, Columns.Count).End(xlToLeft).Column
    If sht.Cells(1, rWB) <> "" Then rWB = rWB + 1
    r = sht.Cells(2, rWB)
    If IsNull(r) Or r = 0 Then r = 3
    sht.Cells(1, rWB) = ActiveWorkbook.Name
    sht.Cells(r, rWB) = asht.ActiveSheet.Name
    sht.Cells(2, rWB) = r + 1
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial