Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA Unwanted loop through worksheets

Tags:

loops

excel

vba

I have used this site quite a bit but this is the first question i have posted, hopefully I can give enough detail. I cannot find any relevant answers because no matter what i search, I get various answers relating to looping code.

Some background: I have designed an excel document to track some items in my workplace (hereafter referred to as Master Document). As the previous tracker allowed users to edit anything at any time, I have used forms to ensure all information is entered correctly and stored securely. For each item in the Master Document there is a separate excel workbook (hereafter referred to as Item Document).

There are a number of sheets in the Master Document which run code everytime they are activated (because they need to update).

As there is some VBA code in every Item Document which is crucial in syncing data with the Master Document, I have added a Warning worksheet which is shown when the Item Document is opened without macros. This involved using the workbook open, before save and after save events to ensure only the Warning is shown without macros. Here is the code for each event (placed in ThisWorkbook Module obviously)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Auto_Open

    'This is for sync (Master Document checks for text file to see if any changes have been made to Item Document)
    If booChange = True Then
        Dim oFile As Object
        Set oFile = fso.CreateTextFile(strTextFile)
        SetAttr strTextFile, vbHidden
        booChange = False
    End If

    'Turn off Screen Updating
    Application.ScreenUpdating = False

    'Show warning sheet
    Sheets("Warning").Visible = xlSheetVisible

    'Hide all sheets but Warning sheet
    For Each sh In ThisWorkbook.Worksheets
        If Not sh.Name = "Warning" Then sh.Visible = xlVeryHidden
    Next sh

End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    'Show all sheets
    For Each sh In ThisWorkbook.Worksheets
        sh.Visible = xlSheetVisible
    Next sh

    'Hide the warning sheet
    Sheets("Warning").Visible = xlVeryHidden

    'Return focus to the main page
    ThisWorkbook.Worksheets(1).Activate

    'Turn on Screen Updating
    Application.ScreenUpdating = True

    ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_Open()

    'Turn off Screen Updating
    Application.ScreenUpdating = False

    'Show all sheets
    For Each sh In ThisWorkbook.Worksheets
        sh.Visible = xlSheetVisible
    Next sh

    'Hide the warning sheet
    Sheets("Warning").Visible = xlVeryHidden

    'Return focus to the main page
    ThisWorkbook.Worksheets(1).Activate

    'Turn on Screen Updating
    Application.ScreenUpdating = True

    ThisWorkbook.Saved = True

End Sub

And just for completeness, here is all code in Module1 of Item Document

'Declarations
'Strings
Public strSourceFolder As String
Public strTextFile As String

'Other
Public fso As FileSystemObject
Public booChange As Boolean
Public wsFlow As Worksheet

'Constants
Public Const strURNSheetName = "Part 1 Plant Flow Out Summ"

Sub Auto_Open()

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wsFlow = ThisWorkbook.Worksheets(strURNSheetName)
    strSourceFolder = fso.Getfile(ThisWorkbook.FullName).ParentFolder.Path
    strTextFile = fso.BuildPath(strSourceFolder, ThisWorkbook.Worksheets(strURNSheetName).Range("W2").Value & ".txt")

End Sub

When an item is created in the Master Document using the 'frmNewEntry' form the info is checked and entered into the Master Document then a template Item Document is opened and saved with a new unique filename. It is then unprotected, updated with the new information, protected, saved and closed. The Master Document is then saved. Code follows (edited to omit lengthy formatting and data entry):

Form Code:

Private Sub btnSave_Click()
    'Values on form are verified
    'Master Document sheet is unprotected, formatted and data entry occurs

    'Clear Userform and close
    For Each C In frmNewEntry.Controls
        If TypeOf C Is MSForms.ComboBox Then
            C.ListIndex = -1
        ElseIf TypeOf C Is MSForms.TextBox Then
            C.Text = ""
        ElseIf TypeOf C Is MSForms.CheckBox Then
            C.Value = False
        End If
    Next
    frmNewEntry.Hide

    'Create filepaths
    Create_Filepath

    'Some hyperlinks are added and the Master Document worksheet is protected again

    'Create Flowout Summary
    Create_Flowout_Summary

    'Update Flowout Summary
    Update_Flowout_Summary

    'Turn on screen updating
    Application.ScreenUpdating = True

    'Update Activity Log
    Update_Log ("New: " & strNewURN)

    Debug.Print "Before Save Master"

    'Save tracker
    ThisWorkbook.Save

    Debug.Print "After Save Master"

End Sub

Module1 Code:

Public Sub Create_Flowout_Summary()
'Create a new flowout summary from the template

    'Turn off screen updating
    Application.ScreenUpdating = False

    'Check if workbook is already open
    If Not Is_Book_Open(strTemplate) Then
        Application.Workbooks.Open (strTemplatePath)
    End If

    Debug.Print "Before SaveAs Create"

    'Save as new flowout summary
    Application.Workbooks(strTemplate).SaveAs fileName:=strFilePath

    Debug.Print "After SaveAs Create"

    'Close Document Information Panel
    ActiveWorkbook.Application.DisplayDocumentInformationPanel = False  'Doesn't seem to work

    'Turn on screen updating
    Application.ScreenUpdating = True

End Sub

Public Sub Update_Flowout_Summary()
'Update the flowout summary for current call

    Dim wsURN As Worksheet

    Set wsURN = Workbooks(strFileName).Worksheets(strWsURNName)

    'Unprotect Flowout Summary worksheet
    wsURN.Unprotect "Flowout Summary"

    'Write values to flowout summary

    'Protect Flowout Summary worksheet
    wsURN.Protect "Flowout Summary", False, True, True, True, True

    Debug.Print "Before Save Update"

    'Save flowout summary
    Application.Workbooks(strFileName).Save

    Debug.Print "After Save Update"

    'Close Document Information Panel
    ActiveWorkbook.Application.DisplayDocumentInformationPanel = False

    'Turn on screen updating
    Application.ScreenUpdating = True

End Sub

Problem detail: When I create a new entry it is taking a very long time, I accidentally discovered that the Master Document is running the code in every sheet activate event (mentioned above) (I had a diagnostic msgbox in one of the sheets which mysteriously appeared when i created a new entry) I have therefore drawn the conclusion that the code is somehow activating every worksheet but have no idea why....

Any help will be much appreciated, and if i have missed anything out that may help in diagnosing just let me know.

EDIT: The other strange phenomenon is that this does not happen when I try to step through the code to find exactly where the activate events are being triggered.

EDIT: Code in the worksheet activate event

Private Sub Worksheet_Activate()

    'Turn off Screen Updating
    Application.ScreenUpdating = False

    'Simply writes data to the sheet (excluded because it is lengthy)

    'Turn on Screen Updating
    Application.ScreenUpdating = True

    wsMyCalls.Protect Password:=strPassword

    Debug.Print "wsMyCalls"

    MsgBox "This sheet uses your username to display any calls you own." & vbNewLine & _
    "It relies on the correct CDSID being entered for owner." & vbNewLine & vbNewLine & _
    "Regards" & vbNewLine & _
    "Your friendly spreadsheet administrator", vbOKOnly, "Information"

End Sub

EDIT: I added some Debug.Prints to the code (above) and this is what i got.

  • Before SaveAs Create
  • After SaveAs Create
  • Before Save Update
  • After Save Update
  • Before Save Master
  • After Save Master
  • wsMyCalls

This shows that the code is executing between Debug.Print "After Save Master" and an End Sub. There is no code in there???

Thanks

like image 630
Nervix Avatar asked Nov 10 '22 06:11

Nervix


1 Answers

I believe we aren't seeing your whole code on here. It is difficult to diagnose considering we don't have the workbook to debug ourselves. However I have a similar 'welcome' page that is displayed every time one of my workbooks opens to ask the user to activate macroes. I DO put EnableEvents to false and put my sheet in a certain state before saving, and placing it back after saving.

I will show you exactly how I do it because I have a feeling your problem is related to not disabling EnableEvents are the right timings. I am unsure how to time it based on how your workbook functions because of the mentioned incomplete code.

The sheet is called f_macros. Here is it's worksheet activate event that prevents further navigation:

Private Sub Worksheet_Activate()
     ActiveWindow.DisplayHeadings = False
     ActiveWindow.DisplayWorkbookTabs = False
End Sub

In my Workbook_BeforeSave:

I record the current state of DisplayHeadings and such at first:

Dim Displaytabs As Boolean
Dim DisplayHeadings As Boolean
Dim menu As CommandBar
Dim ligne As CommandBarControl

Displaytabs = ActiveWindow.DisplayWorkbookTabs
DisplayHeadings = ActiveWindow.DisplayHeadings

I then reset my custom right click, turn off EnableEvents and screen updating. I set DisplayWorkbookTabs to false for good measure.

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.CommandBars("Cell").reset
ActiveWindow.DisplayWorkbookTabs = False

Then I run Cacherdata (HideData, sub in another module that is annexed underneath) I save, and i run the sub macro_activees to put the workbook back in working order for the user. I turn EnableEvents back on, and put the headings back to how they were:

m_protection.Cacherdata
ThisWorkbook.Save
m_protection.macro_activees

Application.ScreenUpdating = True
Application.enableevents = True
ActiveWindow.DisplayWorkbookTabs = Displaytabs
ActiveWindow.DisplayHeadings = DisplayHeadings

I cancel the ordinary Save (important!) and indicate the workbook is saved so they can exit normally without being prompted to save.

Cancel = True
ThisWorkbook.Saved = True

In the BeforeClose, it checks whether or not the workbook state is Saved. if yes, it quits. If not, it does a similar procedure:

If Not (ThisWorkbook.Saved) Then


         rep = MsgBox(Prompt:="Save changes before exiting?", _
            Title:="---", _
            Buttons:=vbYesNoCancel)

    Select Case rep
        Case vbYes
            Application.ScreenUpdating = False
            Application.enableevents = False
            ActiveWindow.DisplayHeadings = True
            m_protection.Cacherdata

            ThisWorkbook.Save

        Case vbCancel
            Cancel = True
            Exit Sub
    End Select
End If

The workbook open event checks whether it is read-only mode, but that's all. I don't have a Workbook AfterSave.

Annex

CacherData makes every sheet VeryHidden so the user doesn't f*** up the data without activating macros. It records the current active sheet so the user goes back to where they were, unprotects the workbook, hides sheets, protects it back and that's all:

Sub Cacherdata()
    Dim ws As Worksheet

    f_param.Range("page_active") = ActiveSheet.Name
    f_macros.Activate


    ThisWorkbook.Unprotect "-----"

    For Each ws In ThisWorkbook.Worksheets
        If ws.CodeName <> "f_macros" Then ws.visible = xlSheetVeryHidden
    Next
    ThisWorkbook.Protect "-----"

    Exit Sub

End Sub

macros_activees does the opposite:

Sub macro_activees()
    Dim ws As Worksheet


    ThisWorkbook.Unprotect "-----"
    For Each ws In ThisWorkbook.Worksheets
        ws.visible = xlSheetVisible
    Next
    ThisWorkbook.Sheets(f_param.Range("page_active").Value).Activate
    ThisWorkbook.Unprotect "-----"
'it unportects twice because of the activate event of the worksheet, don't mind that
    Exit Sub
End Sub

Error handling was removed because it was useless to show, but everything else should be there.

EDIT: If this doesn't help you at all, maybe your problem is because the workbooks you create have code in them 9from what i gather) that can affect how long it takes to run your code? If they have an Open procedure themselves, could that be it?

like image 176
David G Avatar answered Dec 01 '22 11:12

David G