asked on

IE Style navigation for Excel

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

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

byundt

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