PDA

View Full Version : [SOLVED] Excel Freezing Up When I Run Sub



mongoose
07-25-2019, 09:24 AM
My code works fine if the sheet has multiple entries in Column A: like so...

A1: 3
A2: 4
A3: 5

But, if COL A has only one entry, like A1: 9, then it crashes the program.

24675

24676

24677

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.



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(2)
'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

'Kill sub if cel is empty
If IsEmpty(cel) = True Then
MsgBox ("True")
Exit Sub
End If
Next cel
Next oFile
End With
End Sub




I put this in to try to stop it from crashing, which is does, but it doesn't put the hyperlinks and color changes in.

Artik
07-25-2019, 01:24 PM
If there are no gaps in Column A, you can replace this code fragment

Set SOPID = .Range("A1", .Range("A1").End(xlDown)) with such
Set SOPID = .Range("A1").CurrentRegion.Columns(1).Cells
If you have only one record, Range("A1").End(xlDown) points to the cell in the last row of the sheet.

Artik

Bob Phillips
07-25-2019, 04:16 PM
Try


Dim SOPID As Range: Set SOPID = IIf(.Range("A2").Value = vbNullString, .Range("A1"), .Range("A1", .Range("A1").End(xlDown)))

mongoose
07-26-2019, 08:08 AM
Try


Dim SOPID As Range: Set SOPID = IIf(.Range("A2").Value = vbNullString, .Range("A1"), .Range("A1", .Range("A1").End(xlDown)))



I tried this and it fixed it; is there any benefit or difference between the two statements?


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

mongoose
07-26-2019, 08:12 AM
I have to improve this code somehow in speed. I know the problem is in the For Each statement but I really don't know where to start to fix it.

24681



Private Sub chkAuditDates()
'Set path to audits (NETWORK)
Const FolderPath As String = "\\JACKSONVILLE-DC\Common\SOP's for JV\SOP Audits\2019"
'Set path to audits (LOCAL)
'Const FolderPath As String = "C:\Users\jbishop\Desktop\SOP Audits with New Names"

'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(3)
'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("A" & .Rows.Count).End(xlUp))
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

'Autosize columns to best fit inserted data
.Columns("A:P").AutoFit
End With
'Next i
End Sub


It freezes excel if I run it on all 12 sheets. If I change the code and manually tell it an individual sheet to run it on, it works but it is slow.

Bob Phillips
07-26-2019, 09:35 AM
I tried this and it fixed it; is there any benefit or difference between the two statements?


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

Yeah, one works, one doesn't.