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.
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.