IE Style navigation for Excel

'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

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79: