Strange Occurences

[Guest]

I have some start-up code that is causing me fits. It will just continually
run and I can't break it. But if I place some msgboxes at places within the
code, without changing ANYTHING ELSE, it works fine. I don't get it. And if
I go to the macro editor during this execution sometimes the explorer section
on the left is ALL GRAY. And the sheet names are in blue and the actual
names are not shown, only sheet1, sheet2, etc, not sheet1 (Main) sheet2
(Data), etc. Any ideas what is causing this strange goings on?

 

[Guest]

post it

 

[Guest]

Below is what is in the Thisworkbook:

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("&Inventory").Delete
Call ResetMenu
End Sub

Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Cursor = xlWait



Call Module1.SetUpStuff("Start")
'MsgBox ("ready to call Protect all sheets")
Call Module1.ProtectAllSheets
'MsgBox ("ready to run last of the macro wb open")

Dim Menu1 As CommandBarControl
Dim MainMenuBar As CommandBar
Dim CustomMenu As CommandBarControl
On Error Resume Next
Usrname = fOSUserName

Application.CommandBars("Worksheet Menu Bar").Controls("&Inventory").Delete
On Error GoTo 0
Set MainMenuBar = Application.CommandBars("Worksheet Menu Bar")
HelpMenu = MainMenuBar.Controls("Help").Index
Set CustomMenu = MainMenuBar.Controls.Add(Type:=msoControlPopup,
Before:=HelpMenu)
CustomMenu.Caption = "&Inventory"
With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "New Transfer"
.OnAction = "EnterTransfer"
End With
With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "New Order"
.OnAction = "EnterOrder"
End With
' If Usrname = "msmoot" Or Usrname = "mhirsch" Then
' With CustomMenu.Controls.Add(Type:=msoControlButton)
' .Caption = "Create JE for Uploading"
' .OnAction = "NewCreateJE"
' End With
' With CustomMenu.Controls.Add(Type:=msoControlButton)
' .Caption = "Validate JE "
' .OnAction = "ValidateJE"
' End With
' With CustomMenu.Controls.Add(Type:=msoControlButton)
' .Caption = "Stats JE Create "
' .OnAction = "StatsDIJEUpload"
' End With
' End If
With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Add Item (Current Order)"
.OnAction = "AddItem"
End With

With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Post Order/Transfer"
.OnAction = "PostTransfer"
End With
With CustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Reset Mouse"
.OnAction = "MouseReset"
End With
MsgBox ("ready to call sub addmenu")
Call AddMenu
MsgBox ("ready to call addsubmenu")
Call AddSubMenu

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault


End Sub


The calls to other subs are:

Sub ResetMenu()
Application.CommandBars("Cell").Reset
End Sub

Sub SetUpStuff(WhereFrom As String)
Dim X As Integer
Dim Foundit As Integer
Dim tmp As Variant

MsgBox ("Welcome to the Inventory Transfer Spreadsheet.")

Call UNProtectAllSheetsForProcessing

Application.ScreenUpdating = False


Sheets("EmployeeListing").Visible = True
Sheets("items").Visible = True


'Range("items").Select
Application.GoTo reference:="Items"
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("items").Visible = False

'Active.Workbook.RefreshAll

Application.GoTo reference:="DataSource"
Let DataSource = ActiveCell.Value
Application.GoTo reference:="ThisFile"

Let ThisFile = ActiveCell.Value
Let ThisFileOnly = FileFromPath(ThisFile)

PurchFile(1) = Range("PurchFile1").Value
PurchFile(2) = Range("PurchFile2").Value
PurchFile(3) = Range("PurchFile3").Value


UsrID = fOSUserName
Application.ScreenUpdating = False
Application.GoTo reference:="usrid"
ActiveCell.Value = UsrID

Range("usernamestart").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Calculate
Range("usernamestart").Select
Let X = ActiveCell.Row
Let Foundit = 0
Do While True
X = X + 1
If Cells(X, 1).Value = Empty Then
Exit Do
End If
If LCase(Cells(X, 1).Value) = LCase(UsrID) Then
Let FirstName = Cells(X, 2).Value
Let LastName = Cells(X, 3).Value
Let ApprovesFor = Cells(X, 4).Value
Let OrdersFor = Cells(X, 5).Value
Let EmailFrom = Cells(X, 6).Value
Let Foundit = 1
Exit Do
End If
Loop
If Foundit = 0 Then
Beep
Let tmp = MsgBox(Prompt:="You are not authorized to enter or approve
transfers. Please consult with your supervisor to get this changed! File
will now unload itself!", Buttons:=vbOKOnly, Title:="Authorization Issue!")
ActiveWindow.Close , savechanges:=False
End If

Sheets("EmployeeListing").Visible = False

Sheets("TransferDetail").Visible = True
Sheets("transferdetail").Select
Cells(1, 9).Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Selection.AutoFilter Field:=9, Criteria1:=UsrID
'Sheets("TransferHeader").Select
Calculate

On Error Resume Next
With Sheets("TransferHeader")
.Visible = xlSheetVisible
.Select
End With

Cells(7, 1).Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Selection.AutoFilter Field:=1, Criteria1:=UsrID

'Call ProtectAllSheets

End Sub

Sub ProtectAllSheets()
'this is the function to lock protection on all spreadsheets.
Dim wSheet As Worksheet
Dim Usrname As String

Application.ScreenUpdating = False
Sheets("EmployeeListing").Visible = True
Sheets("Items").Visible = True

Usrname = fOSUserName
For Each wSheet In Worksheets
wSheet.Protect Password:="xxxxxxx", AllowFormattingColumns:=True
Next wSheet
TheEnd:

Sheets("EmployeeListing").Visible = False
Sheets("Items").Visible = False


Application.ScreenUpdating = True

End Sub