locked
Excel is freezing up when I run my Sub on all sheets RRS feed

  • Question

  • My code works fine if I am only running it on one of the 12 worksheets, but when I put the For Loop in to loop through all sheets, it overloads and I have to end task, and cannot successfully open the file again.

    Here are the file name examples:

    SOP-JV-001-CHL-Test SOP Title-EN.docx

    SOP_Audit-JV-003-01102019.docx

    Here's my code.

    Option Explicit


    Private Sub Workbook_Open()
    '   Set network folder path
        'Const FolderPath As String = "\\jacksonville-dc\common\Jonathan Bishop\SOPs With New Names"
    '   Set local folder path
        Const FolderPath As String = "C:\Users\jbishop\Desktop\SOP Audit Excel Prototype\SOPs"
        
    '   Set allowed file type(s)
        Const FileExt As String = "docx"


    '   Instantiate FSO
        Dim oFSO As Object
        Dim oFolder As Object
        Dim oFiles As Object
        Dim oFile As Object
        
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(FolderPath)
        Set oFiles = oFolder.Files
        
        Dim v As Variant
        Dim iSheet As Long

    '   Clear Worksheets
        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
            ws.Cells.ClearContents
            ws.Cells.Interior.Color = xlNone
        Next ws

        'Loop through each file in FSO
        For Each oFile In oFiles
            If LCase(Right(oFile.Name, 4)) = FileExt Then
                
                'Split filename
                v = Split(oFile.Name, "-")
            
                'Use dept code as Select variable
                Select Case v(3)
                    Case "PNT", "VLG", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 1, v)
                    
                    Case "CRT", "AST", "SHP", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 2, v)
        
                    Case "CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 3, v)
        
                    Case "SCR", "THR", "WSH", "GLW", "PTR", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 4, v)
        
                    Case "PLB", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 5, v)
        
                    Case "DES"
                        Call pvtPutOnSheet(oFile.Path, 6, v)
        
                    Case "AMS"
                        Call pvtPutOnSheet(oFile.Path, 7, v)
        
                    Case "EST"
                        Call pvtPutOnSheet(oFile.Path, 8, v)
        
                    Case "PCT"
                        Call pvtPutOnSheet(oFile.Path, 9, v)
        
                    Case "PUR", "INV"
                        Call pvtPutOnSheet(oFile.Path, 10, v)
        
                    Case "SAF"
                        Call pvtPutOnSheet(oFile.Path, 11, v)
        
                    Case "GEN"
                        Call pvtPutOnSheet(oFile.Path, 12, v)
                End Select
            End If
        Next oFile
        
        'Call Sub Procedure that will cross check SOPs with SOP audits
        Call chkAuditDates
    End Sub


    Private Sub chkAuditDates()
        'Set path to audits (NETWORK)
        'Const FolderPath As String = "\\jacksonville-dc\common\test\SOP Audits with New Names"
        'Set path to audits (LOCAL)
        Const FolderPath As String = "C:\Users\jbishop\Desktop\SOP Audit Excel Prototype\SOP Audits"
        
        'Instantiate the FSO & related vars
        Dim oFSO As Object: Set oFSO = CreateObject("Scripting.FileSystemObject")
        Dim oFolder As Object: Set oFolder = oFSO.GetFolder(FolderPath)
        Dim oFiles As Object: Set oFiles = oFolder.Files
        Dim oFile As Object
            
        Dim i As Integer
        'Loop through all worksheets - NEED TO ESTABLISH LOOP/CURRENTLY SET TO ONE SHEET
        For i = 1 To 12
            With Worksheets(i)
                'Set cell background color to Red for a range of cells
                With .Range("E1:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
                    '.Interior.Color = RGB(255, 0, 0)
                    .HorizontalAlignment = xlCenter
                    .Font.Color = vbBlack
                    .Font.Bold = True
                End With
                
                'Store cells in COL A that have values as a range
                Dim SOPID As Range: Set SOPID = .Range("A1", .Range("A1").End(xlDown))
                Dim cel As Range
                
                'Loop through each SOP audit file
                For Each oFile In oFiles
                    'Strip audit date out of filename and trim off the file extension
                    Dim auditDate: auditDate = CDate(DateSerial(Right(Left(Split(oFile.Name, "-")(3), 8), 4), _
                                                                Left(Left(Split(oFile.Name, "-")(3), 8), 2), _
                                                                Mid(Left(Split(oFile.Name, "-")(3), 8), 3, 2)))
                    
                    'Loop through all SOP IDs stored in COL A
                    For Each cel In SOPID
                        'See if SOP ID in COL A matches SOP ID in Audit file name
                        If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(cel) Then
                            'Insert link to audit, change background color, etc of selected cell
                            With cel.Offset(0, 3 + Month(auditDate))
                                .Hyperlinks.Add Anchor:=cel.Offset(0, 3 + Month(auditDate)), Address:=oFile.Path, TextToDisplay:="X"
                                .Interior.Color = RGB(34, 139, 34)
                                .Font.Color = vbBlack
                                .Font.Bold = True
                            End With
                        End If
                    Next cel
                Next oFile
            End With
        Next i
    End Sub


    Private Sub pvtPutOnSheet(sPath As String, i As Long, v As Variant)
        Dim r As Range
        
        With Worksheets(i)
            Set r = .Cells(.Rows.Count, 1).End(xlUp)
            If Len(r.Value) > 0 Then Set r = r.Offset(1, 0)     '   next empty cell in Col A
            
            If UBound(v) > 3 Then
                r.Value = v(2)              '   Col A = "001"
                r.Offset(0, 1).Value = v(3) '   Col B = "CHL"
                'Create hyperlink in each cell
                .Hyperlinks.Add Anchor:=r.Offset(0, 2), Address:=sPath, TextToDisplay:=v(4) '   Col C = "Letter Lock for Channel Letters" with link to Path
                r.Offset(0, 3).Value = Left(v(5), 2) '   Col = "EN"
            End If
        
        End With
    End Sub


    Function RemoveLeadingZeroes(ByVal str)
        Dim tempStr
        tempStr = str
        While Left(tempStr, 1) = "0" And tempStr <> ""
            tempStr = Right(tempStr, Len(tempStr) - 1)
        Wend
        RemoveLeadingZeroes = tempStr
    End Function

    Thursday, July 25, 2019 2:31 PM

Answers

  • What if you change

    Set SOPID = .Range("A1", .Range("A1").End(xlDown))

    to

    Set SOPID = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by mongoose00318 Thursday, July 25, 2019 7:51 PM
    Thursday, July 25, 2019 4:41 PM

All replies

  • If you want to loop through the sheets, you have to be very careful to make all cell/range references refer to the sheet in the loop. The line

            With Range("E1:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)

    should be

            With .Range("E1:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)

    and the line

                        With Cells(i, 4 + Month(auditDate))

    should be

                        With .Cells(i, 4 + Month(auditDate))


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, July 25, 2019 3:10 PM
  • Okay, maybe I just found a clue that could help.

    I took the For Loop out and just set it to Worksheet(1)...ran it and it worked. Changed it manually to Worksheet(2) and it crashes. So it wasn't the For Loop that was crashing it. It's crashing only on sheets that have one SOP listed, any that have more than 1 it works?

    Private Sub chkAuditDates()
        'Set path to audits (NETWORK)
        'Const FolderPath As String = "\\jacksonville-dc\common\test\SOP Audits with New Names"
        'Set path to audits (LOCAL)
        Const FolderPath As String = "C:\Users\jbishop\Desktop\SOP Audit Excel Prototype\SOP Audits"
        
        'Instantiate the FSO & related vars
        Dim oFSO As Object: Set oFSO = CreateObject("Scripting.FileSystemObject")
        Dim oFolder As Object: Set oFolder = oFSO.GetFolder(FolderPath)
        Dim oFiles As Object: Set oFiles = oFolder.Files
        Dim oFile As Object
            
        'Loop through all worksheets - NEED TO ESTABLISH LOOP/CURRENTLY SET TO ONE SHEET
        With Worksheets(1)
            'Set cell background color to Red for a range of cells
            With Range("E1:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
                '.Interior.Color = RGB(255, 0, 0)
                .HorizontalAlignment = xlCenter
                .Font.Color = vbBlack
                .Font.Bold = True
            End With
            
            'Store cells in COL A that have values as a range
            Dim SOPID As Range: Set SOPID = .Range("A1", .Range("A1").End(xlDown))
            Dim cel As Range
            
            'Loop through each SOP audit file
            For Each oFile In oFiles
                'Strip audit date out of filename and trim off the file extension
                Dim auditDate: auditDate = CDate(DateSerial(Right(Left(Split(oFile.Name, "-")(3), 8), 4), _
                                                            Left(Left(Split(oFile.Name, "-")(3), 8), 2), _
                                                            Mid(Left(Split(oFile.Name, "-")(3), 8), 3, 2)))
                
                'Loop through all SOP IDs stored in COL A
                For Each cel In SOPID
                    'See if SOP ID in COL A matches SOP ID in Audit file name
                    If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(cel) Then
                        'Insert link to audit, change background color, etc of selected cell
                        With cel.Offset(0, 3 + Month(auditDate))
                            .Hyperlinks.Add Anchor:=cel.Offset(0, 3 + Month(auditDate)), Address:=oFile.Path, TextToDisplay:="X"
                            .Interior.Color = RGB(34, 139, 34)
                            .Font.Color = vbBlack
                            .Font.Bold = True
                        End With
                    End If
                Next cel
            Next oFile
        End With
    End Sub


    Thursday, July 25, 2019 3:44 PM
  • What if you change

    Set SOPID = .Range("A1", .Range("A1").End(xlDown))

    to

    Set SOPID = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by mongoose00318 Thursday, July 25, 2019 7:51 PM
    Thursday, July 25, 2019 4:41 PM
  • That did it! Thank you!
    Thursday, July 25, 2019 7:51 PM