I have a workbook that has several things that monitor movement on sheets.
Before I close and before I save (in the appropriate functions) I issue On
Error Goto 0 but when I type data on a new workbook the sub for workbook_Open
runs and the previously closed file reopens and I get an error message as
some of the tabs on the current sheet are not the same name that the one that
was closed refer to. Why can't I get this previous workbook's functions to
quit "holding on" and running?

When you type into the workbook, the workbook_Open sub should not trigger.
I'm thinking it would be a worksheet_Change event that would trigger. Can
you show your code?
--
HTH,
Barb Reinhardt



"Mike H." wrote:

I have a workbook that has several things that monitor movement on sheets.
Before I close and before I save (in the appropriate functions) I issue On
Error Goto 0 but when I type data on a new workbook the sub for workbook_Open
runs and the previously closed file reopens and I get an error message as
some of the tabs on the current sheet are not the same name that the one that
was closed refer to. Why can't I get this previous workbook's functions to
quit "holding on" and running?

This is the entire ThisWorkbook code on the file that is closed that reopens
when I change data on a remaining sheet. Any ideas would be greatly
appreciated. THanks.

Option Base 1
Public ExpireYr1 As Integer
Public ExpireYr2 As Integer
Public ExpireYr3 As Integer
Public TheRow As Long
Public UsrName
Public HelpMenu
Public HadErr As Integer
Public TheCol As Long
Option Explicit




Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo 0
End Sub

Private Sub Workbook_Open()

Dim SubName As String
Dim Goback As Integer
Dim WhichGroup As String
Dim Txt As String
Let SubName = "StartWork"
On Error GoTo handleCancelWBO
Dim X As Long
'ActiveWindow.Close , savechanges:=False
'Windows("book1").Activate


Let Txt = ActiveWorkbook.Name
If 1 = 1 Then
MsgBox ("why am I in here")
End If

'If LCase(Txt) Like "dailyinpu*" Then
'Else
'ActiveWindow.Close
'End If

'Open ThisWorkbook.Path & "\usage.log" For Append As #1
'If ThisWorkbook.ReadOnly = True Then
' Print #1, Application.UserName, Now, " In File-Read Only"
'Else
' Print #1, Application.UserName, Now, " In File-Read/Write"
'End If
'Close #1

Dim FilePath As String
Dim CritRange As Range
Dim Fnd As Long
Dim DataArray(500, 1) As Variant
Dim Y As Long
With ActiveWorkbook
Let FilePath = .Path
End With
'MsgBox (FilePath)
If UCase(Right(FilePath, 4)) = "ENDO" Then
Let WhichGroup = "ENDO"
ElseIf UCase(Right(FilePath, 3)) = "URO" Then
Let WhichGroup = "URO"
ElseIf UCase(Right(FilePath, 4)) = "COMP" Then
Let WhichGroup = "PI/COMP"
Else
Let WhichGroup = "ASK"
End If

If WhichGroup = "ASK" Then
Call RunChangeCC
GoTo DoRestOfIt
End If

Sheets("Parameters").Visible = True
Sheets("parameters").Select
Range("CostCenters").Select

X = ActiveCell.Row
Do While True
If Cells(X, 3).Value = Empty Then Exit Do
If IsError(Cells(X, 6).Value) = False Then
If Cells(X, 6).Value = WhichGroup Then
Fnd = Fnd + 1
DataArray(Fnd, 1) = Cells(X, 3).Value
End If
End If
X = X + 1
Loop
Sheets("Parameters").Visible = False
Call Module1.UNProtectSheets
'MsgBox ("set here")

For Y = 1 To 2
If Y = 1 Then
Sheets("replacement prod assets").Select
Call Module1.UNProtectSheets
Else
Sheets("replacement facilities assets").Select
Call Module1.UNProtectSheets
End If
X = 2
Do While True
If Cells(X, 1).Value = Empty Then Exit Do
Cells(X, 1).Value = Empty
Cells(X, 2).Value = Empty
Cells(X, 3).Value = Empty
Cells(X, 4).Value = Empty
X = X + 1
Loop


For X = 1 To Fnd
Cells(X + 1, 1).Value = DataArray(X, 1)
Cells(X + 1, 2).Value = "Y"
Cells(X + 1, 3).Value = 1
Cells(X + 1, 4).Value = WhichGroup
Next
Cells(11, 1).Select
Range("B11").Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo handleCancelWBO
X = 11
Do While True
If Cells(X, 2).Value = Empty Then Exit Do
X = X + 1
Loop

Range("A10:FM" & X - 1).AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Range("A1:D" & Fnd + 1), Unique:=False
Next

Call FixChartANdPT



Call Module1.ProtectSheets

DoRestOfIt:


'MsgBox ("going to start adding menus")
'Call ProtectAllSheets
Dim Menu1 As CommandBarControl
Dim MainMenuBar As CommandBar
Dim CustomMenu As CommandBarControl
On Error Resume Next
UsrName = fOSUserName

Application.CommandBars("Worksheet Menu Bar").Controls("&Decision
Matrix").Delete
On Error GoTo 0
Set MainMenuBar = Application.CommandBars("Worksheet Menu Bar")
HelpMenu = MainMenuBar.Controls("Help").Index
Set CustomMenu = MainMenuBar.Controls.Add(Type:=msoControlPopup,
Befo=HelpMenu)
CustomMenu.Caption = "&Decision Matrix"
With CustomMenu.Controls.Add(Type:=msoControlPopup)
.Caption = "Assets"
With .Controls.Add(Type:=msoControlButton)
.Caption = "&Sort Assets"
.OnAction = "SortAndPrint"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Show ALL Assets - This Value Stream"
.OnAction = "RedisplayAssets"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Show ONLY Considered Assets"
.OnAction = "ConsideredAssets"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Change Cost Center Focus"
.OnAction = "RunChangeCC"
End With
End With
With CustomMenu.Controls.Add(Type:=msoControlPopup)
.Caption = "Cost Savings"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Load Cost Savings"
.OnAction = "LoadCostSheet"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Store Cost Sheet"
.OnAction = "StoreCostSheet"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Remove Cost Data - DO NO SAVE"
.OnAction = "RunRemoveCostSheet"
End With
End With
If LCase(UsrName) = "hirschm" Then
With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "UnProtect All Sheets"
.OnAction = "Unprotectsheets"
End With
End If
Call AddMenu
Call AddSubMenu



Exit Sub
handleCancelWBO:
'MsgBox (Err)
If Err = 18 Then
Let Goback = MsgBox(prompt:="You interrupted the program by hitting the
Escape key. The system will return to the point where you caused this
intervention. Thank you. (Note, if you wish to stop the program click
Cancel instead of OK)", Title:="French Lick User Intervention by " & UsrName,
Buttons:=vbYesNoCancel + vbCritical)
ElseIf Err = 91 Then
If 1 = 1 Then
Resume Next
End If
Exit Sub
Else
Let Goback = MsgBox(prompt:="In Sub " & SubName & ", there is an Error
(" & Err.Number & ") of " & Err.Description & ". The system will return to
the point where this error was caused. Thank you.", Title:="French Lick
System Error", Buttons:=vbOKCancel + vbCritical)
End If
'Let Goback = MsgBox(Prompt:="In Sub " & SubName & ", there is an Error (" &
Err.Number & ") of " & Err.Description & ". The system will return to the
point where this error was caused. Thank you.", Title:="French Lick System
Error", Buttons:=vbOKCancel + vbCritical)
'Goback = 1

If Goback = 1 Then 'Selected OK
Resume
ElseIf Goback = 2 Then 'Selected Cancel
Exit Sub
ElseIf Goback = 6 Then 'Selected Yes
Resume
ElseIf Goback = 7 Then 'Selected NO
Resume Next
End If
End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
'this builds the menus that are added when this workbook is loaded
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Decision
Matrix").Delete

'With Application
' .EnableEvents = False
' ThisWorkbook.Save
' .EnableEvents = True
'End With

End Sub




'This code would add a menu in the right click popup menu
Private Sub AddMenu()
Dim SubName As String
Dim Goback As Integer
Let SubName = "AddMenu"
On Error GoTo handleCancelAddMenu
Dim cmbPup As CommandBarPopup
ResetMenu

Set cmbPup = Application.CommandBars("Cell").Controls.Add _
(Type:=msoControlPopup)
With cmbPup
.Caption = "Select a worksheet"
.OnAction = "SelectWks"
.BeginGroup = True
End With


Call Module1.ProtectSheets
Sheets("Instructions").Select

Exit Sub
handleCancelAddMenu:
If Err = 18 Then
Let Goback = MsgBox(prompt:="You interrupted the program by hitting the
Escape key. The system will return to the point where you caused this
intervention. Thank you. (Note, if you wish to stop the program click
Cancel instead of OK)", Title:="French Lick User Intervention by " & UsrName,
Buttons:=vbYesNoCancel + vbCritical)
Else
Let Goback = MsgBox(prompt:="In Sub " & SubName & ", there is an Error
(" & Err.Number & ") of " & Err.Description & ". The system will return to
the point where this error was caused. Thank you.", Title:="French Lick
System Error", Buttons:=vbOKCancel + vbCritical)
End If
If Goback = 1 Then 'Selected OK
Resume
ElseIf Goback = 2 Then 'Selected Cancel
Exit Sub
ElseIf Goback = 6 Then 'Selected Yes
Resume
ElseIf Goback = 7 Then 'Selected NO
Resume Next
End If
End Sub






Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Y As Integer

If ActiveSheet.Name Like "*Chart*" Then
Else
TheRow = ActiveCell.Row
TheCol = ActiveCell.Column


'Cells(11, 4).Select
'Let TheRow = 11
'Let TheCol = 4
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)




End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
Dim ANs As Variant
Dim MyEntries As String
Dim WSheet As Worksheet
Dim X As Long
Dim Y As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim Z As Long
Dim Tmp As Double
Dim Denomin As Double
Dim Amt As Double
Dim MyEntryNbr As Integer
Dim TheValue As Variant
Dim CalcVal As Double

Dim CurrentSheet As String
CurrentSheet = ActiveSheet.Name
If CurrentSheet < "Replacement Prod Assets" Then
If CurrentSheet < "Replacement Facilities Assets" Then
GoTo TheEndingFinal
End If
End If

If 1 = 2 Then
GoTo theending
End If

MyEntries = ActiveSheet.Name
Dim SpendCol(4, 4) As Variant
Dim TopScore As Double

If TheCol 0 And TheRow 10 Then
If UCase(Cells(10, TheCol).Value) = "CONSIDER ASSET?" Then
If Cells(TheRow, TheCol).Value < UCase(Cells(TheRow, TheCol).Value)
Then
Cells(TheRow, TheCol).Value = UCase(Cells(TheRow, TheCol).Value)
End If
If Cells(TheRow, TheCol).Value < "Y" Then
If Cells(TheRow, TheCol).Value < "N" Then
If Cells(TheRow, 1).Value < Empty Then
Beep
Let ANs = MsgBox(prompt:="You must enter only a Y or an
N in this column!", Title:="Invalid selection", Buttons:=vbCritical +
vbOKOnly)
HadErr = 1
If Cells(TheRow, TheCol).Value = "NN" Then
Cells(TheRow, TheCol).Value = "N"
Else
Cells(TheRow, TheCol).Value = "Y"
End If
HadErr = 1
End If
'Cells(TheRow, TheCol).Select
End If
End If
GoTo afterrr
End If
End If


If MyEntries < "Replacement Prod Assets" Then
If MyEntries < "New Prod Assets" Then
If MyEntries < "Replacement Facilities Assets" Then
If MyEntries < "New Facilities Assets" Then
GoTo theending
End If
End If
End If
End If
If HadErr = 1 Then
GoTo EndingOf
End If



Y = 1
Do While True
If Cells(10, Y).Value = Empty Then Exit Do
If Cells(10, Y).Value = "Is the Asset going to expire in 2009?" Then
ExpireYr1 = Y
ElseIf Cells(10, Y).Value = "Is the Asset going to expire in 2010?" Then
ExpireYr2 = Y
ElseIf Cells(10, Y).Value = "Is the Asset going to expire in 2011?" Then
ExpireYr3 = Y
ElseIf Cells(10, Y).Value = "Percent Score" Then
Let TopScore = Cells(6, Y).Value
Let FirstCol = Y
ElseIf Cells(10, Y).Value = "Comments" Then
Let LastCol = Y
End If

Y = Y + 1
Loop



If TheCol = 1 And TheRow 10 Then
If (Cells(TheRow, 7).Value) * -1 < Cells(TheRow, 131).Value Then
If Cells(TheRow, 131).Value < Empty Then
HadErr = 1
Cells(TheRow, TheCol).Select
Beep
ANs = MsgBox(prompt:="Since you've changed the Asset Replacement
Cost, you'll need to recalculate the Cost Savings Spreadsheet! Do you wish to
View the Refreshed Data Now?", Title:="Data Has Changed!",
Buttons:=vbCritical + vbYesNo)
'MsgBox (ANs)
'MsgBox (Cells(TheRow, 131).Value)
If ANs = 6 Then
Call UNProtectSheets
Sheets(MyEntries).Select
Cells(TheRow, 131).Value = Cells(TheRow, 7).Value * -1
Cells(TheRow, TheCol).Select
Call Module1.LoadCostSheet
Else
HadErr = 1
TheCol = TheCol + 1
Cells(TheRow, TheCol).Select
End If
End If
End If
End If


If TheRow = 11 And (TheCol FirstCol And TheCol < LastCol) Then
Let TheValue = Cells(TheRow, TheCol).Value
If TheCol = ExpireYr1 Or TheCol = ExpireYr2 Or TheCol = ExpireYr3 Then
Let Z = 0
If Cells(TheRow, ExpireYr1).Value 0 Then
Z = Z + 1
End If
If Cells(TheRow, ExpireYr2).Value 0 Then
Z = Z + 1
End If
If Cells(TheRow, ExpireYr3).Value 0 Then
Z = Z + 1
End If
If Z 1 Then
Beep
Let ANs = MsgBox(prompt:="You may NOT place a value in more than
1 of the Expiration Columns!", Title:="Illegal Multiple Selections!",
Buttons:=vbCritical + vbOKOnly)
Cells(TheRow, TheCol).Value = Empty
HadErr = 1
GoTo afterrr
End If
End If
'If MyEntries = "Replacement Facilities Assets" Then
If TheCol = LastCol Then
Let TheRow = ActiveCell.Row
Let TheCol = ActiveCell.Column
GoTo theending
End If
'End If

If Cells(6, TheCol).Value = "YN" Then
If UCase(TheValue) = "N" Then
Let TheValue = "N"
Cells(TheRow, TheCol).Value = "N"
ElseIf UCase(TheValue) = "Y" Then
Let TheValue = "Y"
Cells(TheRow, TheCol).Value = "Y"
ElseIf TheValue = "YN" Then
Cells(TheRow, TheCol).Value = "Y"
ElseIf (TheValue) = 0 Then

Else
Beep
Let ANs = MsgBox(Title:="Data Entry Error!", prompt:="You may
ONLY enter a Y or an N in this cell! Please fix!", Buttons:=vbOKOnly)
Cells(TheRow, TheCol).Value = Empty
HadErr = 1
End If
Else
If Cells(TheRow, TheCol).Value 5 Then
If Cells(10, TheCol) < "Submitted By" Then
Beep
Let ANs = MsgBox(Title:="Data Entry Error!", prompt:="You
may NOT enter a value GREATER than 5 in this cell! Please fix!",
Buttons:=vbOKOnly)
Cells(TheRow, TheCol).Value = Empty
HadErr = 1
End If
ElseIf Cells(TheRow, TheCol).Value < 1 Then
If TheValue 0.5 Then
Beep
Let ANs = MsgBox(Title:="%-Data Entry Error!", prompt:="You
may NOT enter a value GREATER than 50% in this cell! Please fix!",
Buttons:=vbOKOnly)
Cells(TheRow, TheCol).Value = Empty
HadErr = 1
End If
End If
End If
End If

afterrr:

Let CalcVal = 0
Let Denomin = 0
If FirstCol 0 And TheCol 0 And TheRow 10 And TheCol FirstCol And
TheCol < LastCol Then
For Y = FirstCol + 1 To LastCol - 1
If Cells(6, Y).Value = "R" Then
If Cells(TheRow, Y).Value = 1 Then
Let Tmp = 5
ElseIf Cells(TheRow, Y).Value = 2 Then
Let Tmp = 4
ElseIf Cells(TheRow, Y).Value = 4 Then
Let Tmp = 2
ElseIf Cells(TheRow, Y).Value = 5 Then
Let Tmp = 1
ElseIf Cells(TheRow, Y).Value < 1 Then
Let Tmp = 0
End If
Let CalcVal = CalcVal + (Tmp * Cells(9, Y).Value)
Let Denomin = Denomin + (TopScore * Cells(9, Y).Value)
ElseIf Cells(6, Y).Value = "%" Then
Let CalcVal = CalcVal + (Cells(TheRow, Y).Value * 10 * Cells(9,
Y).Value)
Let Denomin = Denomin + (TopScore * Cells(9, Y).Value)
ElseIf Cells(6, Y).Value = "YN" Then
If Cells(TheRow, Y).Value = "Y" Or Cells(TheRow, Y).Value = "y"
Then
Let CalcVal = CalcVal + (5 * Cells(9, Y).Value)
Let Denomin = Denomin + (TopScore * Cells(9, Y).Value)
Else
Let Denomin = Denomin + (TopScore * Cells(9, Y).Value)
End If
ElseIf Cells(6, Y).Value = "1-5" Then
Let CalcVal = CalcVal + (Cells(TheRow, Y).Value * Cells(9,
Y).Value)
Let Denomin = Denomin + (TopScore * Cells(9, Y).Value)
End If
Next
'Me.Unprotect Password:="Boston55"
Call UNProtectSheets
If Denomin 0 Then
Cells(TheRow, FirstCol).Value = CalcVal / Denomin
End If
'Me.Protect Password:="Boston55" ', AllowFormattingColumns:=True
Call ProtectSheets

End If


If HadErr = 0 Then
'Let TheRow = ActiveCell.Row - 1
'Let TheCol = ActiveCell.Column + 1
'HadErr = 1
'Cells(TheRow, TheCol).Select


Application.OnKey "~", "MyProc"
Application.OnKey "{ENTER}", "MyProc"
Let TheRow = ActiveCell.Row
Let TheCol = ActiveCell.Column
Else
EndingOf:
Cells(TheRow, TheCol).Select
Let HadErr = 0
End If



theending:

If TheRow 10 And TheCol 0 Then
If Cells(10, TheCol).Value = "Estimate Remaining Useful Life of Asset"
Then
If Cells(TheRow, TheCol).Value = Empty Then
Call RunZero_File
End If
ElseIf Cells(10, TheCol).Value = "Remaining Life of Product Line" Then
If Cells(TheRow, TheCol).Value = Empty Then
Call RunZero_File
End If
ElseIf Cells(10, TheCol).Value Like "Estimated Annual Repair*" Then
If Cells(TheRow, TheCol).Value = Empty Then
Call RunPercent
End If
ElseIf Cells(10, TheCol).Value Like "Has the asset caused*" Then
If Cells(TheRow, TheCol).Value = Empty Then
Call RunPercent
End If
ElseIf Cells(6, TheCol).Value = "1-5" Then
If Cells(TheRow, TheCol).Value = Empty Then
Call RunOneFive
End If
ElseIf Cells(6, TheCol).Value = "YN" Then
If Cells(TheRow, TheCol).Value = Empty Then
Call TheYNForm
End If
End If



End If

TheEndingFinal:

End Sub



'This code would add a menu in the right click popup menu and adds sub menus
Private Sub AddSubMenu()
On Error GoTo 0
Dim cmbPup As CommandBarPopup
ResetMenu

Set cmbPup = Application.CommandBars("Cell").Controls.Add _
(Type:=msoControlPopup)
With cmbPup
.Caption = "DailyInput Macros"
.BeginGroup = True
With .Controls.Add(Type:=msoControlButton)
.Caption = "&Control"
.FaceId = 302
.OnAction = "GotoControl"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "&TicketIssues"
.FaceId = 302
.OnAction = "GotoTicketIssues"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "&JE Adjustments"
.FaceId = 302
.OnAction = "GotoJEAdjustments"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "&Select a worksheet"
.FaceId = 302
.OnAction = "SelectWks"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Select &all worksheets"
.FaceId = 303
.OnAction = "SelectAllWks"
End With
End With
End Sub


'This code would Reset the right click popup menu
Sub ResetMenu()
Dim SubName As String
Dim Goback As Integer
Let SubName = "ResetMenu"
On Error GoTo handleCancelRM
Application.CommandBars("Cell").Reset

Exit Sub
handleCancelRM:
If Err = 18 Then
Let Goback = MsgBox(prompt:="You interrupted the program by hitting the
Escape key. The system will return to the point where you caused this
intervention. Thank you. (Note, if you wish to stop the program click
Cancel instead of OK)", Title:="French Lick User Intervention by " & UsrName,
Buttons:=vbYesNoCancel + vbCritical)
Else
Let Goback = MsgBox(prompt:="In Sub " & SubName & ", there is an Error
(" & Err.Number & ") of " & Err.Description & ". The system will return to
the point where this error was caused. Thank you.", Title:="French Lick
System Error", Buttons:=vbOKCancel + vbCritical)
End If
If Goback = 1 Then 'Selected OK
Resume
ElseIf Goback = 2 Then 'Selected Cancel
Exit Sub
ElseIf Goback = 6 Then 'Selected Yes
Resume
ElseIf Goback = 7 Then 'Selected NO
Resume Next
End If
End Sub

There is not. But here is something rather curious I didn't notice before.
I open excel for the first time. Then I open the workbook with the code in
that remains active. Then I unload that workbook and then I go into the VB
editor. The code for that book is still in the editor, even though the file
is unloaded. How can that be?

Also I can Alt-F11 into the code but I can't Alt-F11 back out of it????