Suggestions regarding speed and efficiency

[mongoose]

Hello everyone,

I was just wondering if anyone would mind taking a look at my code to tell me if there is a way to do anything better? It functions as I want, but I haven't run it against the network yet. It's one thing when it's pulling files locally, I've run into problems in the past when I would run it on the network though.

The newest part of the code is the Sub chkAuditDates.



Option Explicit


Private Sub Workbook_Open()
' Set network folder path
'Const FolderPath As String = "\\jacksonville-dc\common\test\SOPs With New Names"
' Set local folder path
Const FolderPath As String = "C:\Users\test\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


For Each oFile In oFiles
If LCase(Right(oFile.Name, 4)) = FileExt Then

v = Split(oFile.Name, "-")

Select Case v(3)
'Setup Select to determine dept values
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 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\test\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

'Loop through each worksheet

'Set red bgcolor for a range of cells for Jan-Current Month

'Loop through each file

'Break filename apart with Split(); looking for SOP ID and the Date

'Loop through each cell in range: "SOP IDs" to see if cell value matches SOP ID in audit filename (Filename(2))

'If there is a match, use the month in the date in Filename(3), to determine which Column to put the link in (E-P:Jan-Dec)

'Use Offset() from the COL A cell being used to insert the link

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

[offthelip]

You have a loop which is executed many many times which is accessing every cell in a range. this is inevitably going to be slow. One of the most frequent causes of slow vba is the time taken to access the worksheet. So one of my ways of speeding up vba is to minimise the number of worksheet accesses, specially in a long loop. It is worth noting that the time taken to load an entire range into a variant array is not much morethan the time to load a single cell . so to speed this up I would change this code:

'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



to something like this: (untested)

Dim sopidarr As Variant
sopidarr = .Range("A1", .Range("A1").End(xlDown))

For i = 1 To UBound(sopidarr, 1)
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(sopidarr(i, 1)) Then
'Insert link to audit, change background color, etc of selected cell
With .Cells(i, 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 i




Depending on the size of the array this could make a lot of difference, using variant arrays is often 1000 time faster

[mongoose]

Is there a way to use a link to activate a Sub onClick; instead of using a button?

All the research I've done indicates that I can't put a button into a cell for alignment purposes...all of the alignment is done with relative positioning. I thought maybe I could insert a link into cells and use that as a button...

[mongoose]

Why do sopidarr as a variant vs a range? Is one data type faster than the other?


You have a loop which is executed many many times which is accessing every cell in a range. this is inevitably going to be slow. One of the most frequent causes of slow vba is the time taken to access the worksheet. So one of my ways of speeding up vba is to minimise the number of worksheet accesses, specially in a long loop. It is worth noting that the time taken to load an entire range into a variant array is not much morethan the time to load a single cell . so to speed this up I would change this code:

'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



to something like this: (untested)

Dim sopidarr As Variant
sopidarr = .Range("A1", .Range("A1").End(xlDown))

For i = 1 To UBound(sopidarr, 1)
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(sopidarr(i, 1)) Then
'Insert link to audit, change background color, etc of selected cell
With .Cells(i, 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 i




Depending on the size of the array this could make a lot of difference, using variant arrays is often 1000 time faster

[mongoose]

I'm getting a type mismatch on For i=1 To UBound(arrSOPID, 1)


'Loop through all SOP IDs stored in COL A For i = 1 To UBound(arrSOPID, 1)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(arrSOPID(i, 1)) 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 i

[mongoose]

The type mismatch is fixed with changing the arrSOPID over to a range. But, my WITH .Cells won't work...Can someone explain what I am doing wrong?


Dim i As Long: i = 0 'Loop through all SOP IDs stored in COL A
For i = 1 To UBound(arrSOPID, 1)
myStr = arrSOPID(i, 1)
'cel = arrSOPID(i, 1)
'MsgBox (myStr)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
With .Cells(i, 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 i

[Leith Ross]

Hello mongoose,

The period before an object indicates that it is part of a With statement. Your line below indicates that Cells belongs to another With statement block.


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

I believe you want to use the Active Worksheet cells. If that is the case remove the period before Cells.

[mongoose]

Run-time error '91': Object variable or With block variable not set.



'Store cells in COL A that have values as a range Dim arrSOPID As Variant: arrSOPID = .Range("A1", .Range("A1").End(xlDown))
Dim cel As Range
Dim myStr As String

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

Dim i As Long: i = 0
'Loop through all SOP IDs stored in COL A
For i = 1 To UBound(arrSOPID, 1)
MsgBox (i)
myStr = arrSOPID(i, 1)
'cel = arrSOPID(i, 1)
'MsgBox (myStr)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
Dim monthCol As Long: monthCol = 3 + Month(auditDate)
'MsgBox (arrSOPID(i + monthCol, 1))
With Cells(i, 4 + 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 i
Next oFile


I'm at a total loss at trying to convert this code over to how Offthelip​ had suggested.

[offthelip]

Why do sopidarr as a variant vs a range? Is one data type faster than the other?
to answer your query from some time back ( apologies for the delay, I have been away)
manipulating Variant data types is usually about 1000 times faster than manipulating Range data types!!. This is because the range data type has to access the worksheet everytime you use it, this takes a long time i.e milliseconds for each access
I have gone through your code and hoepfully got rid of a number of errors for you , try this:


'Store cells in COL A that have values as a range : arrSOPID = .Range("A1", .Range("A1").End(xlDown))
Dim arrSOPID As Variant
Dim cel As Range
Dim myStr As String
Dim monthCol As Long
Dim i As Long
'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)))
' find last row of active sheet
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' load column A into variant array
arrSOPID = Range(Cells(1, 1), Cells(lastrow, 1))


'Loop through all SOP IDs stored in COL A
For i = 1 To lastrow
' MsgBox (i)
myStr = arrSOPID(i, 1)
'cel = arrSOPID(i, 1)
'MsgBox (myStr)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
' cvalculate column to putthe link in
monthCol = 4 + Month(auditDate)
'MsgBox (arrSOPID(i + monthCol, 1))
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range(Cells(i, monthCol), Cells(i, monthCol)), _
Address:=oFile.Path, _
TextToDisplay:="X"
End With
End If
Next i
Next oFile

[Paul_Hossler]

Minor tweaks to consider

You could Dim auditDate one time

I think getting the auditDate was overly complicated, but not sure about the file name format



Dim sDate As String
Dim auditDate As Date


'Loop through each SOP audit file

For Each ofile In oFiles
'Strip audit date out of filename and trim off the file extension
sDate = Split(ofile.Name, "-")(3)
auditDate = DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 3, 2))

[mongoose]

Minor tweaks to consider

You could Dim auditDate one time

I think getting the auditDate was overly complicated, but not sure about the file name format



Dim sDate As String
Dim auditDate As Date


'Loop through each SOP audit file

For Each ofile In oFiles
'Strip audit date out of filename and trim off the file extension
sDate = Split(ofile.Name, "-")(3)
auditDate = DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 3, 2))


I tried changing my code over like you suggested on the auditDate part...I got a type mismatch error.

Also, I figured I go ahead and post my whole code so you can see how it looks now. My first vba project...it's slow but I'm proud of it!



Option Explicit


Private Sub Workbook_Open()


' Set network folder path
Const FolderPath As String = "\\JACKSONVILLE-DC\Common\SOP's for JV\SOPs Final"
' 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
ws.Range("A1").Value = "SOP ID"
ws.Range("B1").Value = "DEPT"
ws.Range("C1").Value = "SOP TITLE"
ws.Range("D1").Value = "LANG"
ws.Range("E1").Value = "JAN"
ws.Range("F1").Value = "FEB"
ws.Range("G1").Value = "MAR"
ws.Range("H1").Value = "APR"
ws.Range("I1").Value = "MAY"
ws.Range("J1").Value = "JUN"
ws.Range("K1").Value = "JUL"
ws.Range("L1").Value = "AUG"
ws.Range("M1").Value = "SEP"
ws.Range("N1").Value = "OCT"
ws.Range("O1").Value = "NOV"
ws.Range("P1").Value = "DEC"
ws.Range("A1:P1").Font.Color = vbBlack
ws.Range("A1:P1").Font.Bold = True
ws.Range("A1:P1").Font.Underline = False
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, "-")
'MsgBox (v(3))
'Exit Sub
'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\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 4
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("A" & .Rows.Count).End(xlUp))
Dim cel As Range
Dim sDate As String
Dim auditDate As Date

'Loop through each SOP audit file
For Each oFile In oFiles
'Strip audit date out of filename and trim off the file extension
sDate = Split(oFile.Name, "-")(3)
auditDate = DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 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




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

[Paul_Hossler]

I tried changing my code over like you suggested on the auditDate part...I got a type mismatch error.

Also, I figured I go ahead and post my whole code so you can see how it looks now. My first vba project...it's slow but I'm proud of it!


1. Probably because my guess at the file format was wrong

2. Working is more important that Fast

[mongoose]

1. Probably because my guess at the file format was wrong

2. Working is more important that Fast

Ya, the file extension was hanging on to the end of the string. I fixed it.

Offthelip's, suggestion I have working after some modification except it is writing to just the first sheet. BUT, I do think it may be a little faster...

Here's the code...


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 4
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 arrSOPID As Variant
Dim cel As Range
Dim myStr As String
Dim monthCol As Long
Dim x As Long

'Loop through each SOP audit file
For Each oFile In oFiles
'Strip audit date out of filename and trim off the file extension
Dim sDate: sDate = Left(Split(oFile.Name, "-")(3), 8)
Dim auditDate As Date
auditDate = CDate(DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 3, 2)))

' find last row of active sheet
Dim lastrow: lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' load column A into variant array
arrSOPID = Range(Cells(1, 1), Cells(lastrow, 1))


'Loop through all SOP IDs stored in COL A
For x = 1 To lastrow
myStr = arrSOPID(x, 1)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
' cvalculate column to putthe link in
monthCol = 4 + Month(auditDate)

With ActiveSheet
.Hyperlinks.Add Anchor:=.Range(Cells(x, monthCol), Cells(x, monthCol)), _
Address:=oFile.Path, _
TextToDisplay:="X"
End With
End If
Next x
Next oFile

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


Also, is there a better way to do this part? Do you guys think it is slowing things down?


' Clear Worksheets
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Cells.ClearContents
ws.Cells.Interior.Color = xlNone
ws.Range("A1").Value = "SOP ID"
ws.Range("B1").Value = "DEPT"
ws.Range("C1").Value = "SOP TITLE"
ws.Range("D1").Value = "LANG"
ws.Range("E1").Value = "JAN"
ws.Range("F1").Value = "FEB"
ws.Range("G1").Value = "MAR"
ws.Range("H1").Value = "APR"
ws.Range("I1").Value = "MAY"
ws.Range("J1").Value = "JUN"
ws.Range("K1").Value = "JUL"
ws.Range("L1").Value = "AUG"
ws.Range("M1").Value = "SEP"
ws.Range("N1").Value = "OCT"
ws.Range("O1").Value = "NOV"
ws.Range("P1").Value = "DEC"
ws.Range("A1:P1").Font.Color = vbBlack
ws.Range("A1:P1").Font.Bold = True
ws.Range("A1:P1").Font.Underline = False
Next ws


Thank you to everyone.

[offthelip]

The answer is yes there is. try to minimise the number of times you access the worksheet, you are writing 16 cells individually on every sheet.
I would do this by loading a two dimensional Variant array with the constants (once) and then writing all 16 cells to the workhseet with a single access by writing directly to the whole range, this is slightly slower than writing one cell but much faster than writng 16 cells

Dim ws As Worksheet
aar = Array("SOP ID", "Dept", "SOP TITLE", "LANG", "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
Dim Vararray(1 To 1, 1 To 16)
For i = 1 To 16
Vararray(1, i) = aar(i - 1)
Next i
For Each ws In ThisWorkbook.Worksheets
ws.Cells.ClearContents
ws.Cells.Interior.Color = xlNone
ws.Range("A1:P1") = Vararray
ws.Range("A1:P1").Font.Color = vbBlack
ws.Range("A1:P1").Font.Bold = True
ws.Range("A1:P1").Font.Underline = False
Next ws

[Paul_Hossler]

I don't think that any possible performance improvements will be perceptible to the user, but this is a another version to consider




Option Explicit

Sub test()
Dim aar As Variant
Dim i As Long

aar = Array("SOP ID", "Dept", "SOP TITLE", "LANG", "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

With Worksheets(1).Cells(1, 1).Resize(1, UBound(aar) + 1)
.ClearContents
.Value = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Trans pose(aar))
.Interior.Color = xlNone
.Font.Color = vbBlack
.Font.Bold = True
.Font.Underline = False
.Copy
End With

For i = 2 To Worksheets.Count
With Worksheets(i)
.Cells.ClearContents
Worksheets(1).Cells(1, 1).Resize(1, UBound(aar) + 1).Copy .Cells(1, 1)
End With
Next i
End Sub

[offthelip]

I don't think that any possible performance improvements will be perceptible to the user, but this is a another version to consider

I do agree with you, however learning how to use variant arrays is one of the easiest ways of learning how to write speedy VBA, which was what I was trying to demonstrate. In this case not particularly useful but in many case of copying it can make a huge difference,

[Paul_Hossler]

I do agree with you, however learning how to use variant arrays is one of the easiest ways of learning how to write speedy VBA, which was what I was trying to demonstrate. In this case not particularly useful but in many case of copying it can make a huge difference,


And I agree with you :thumb:thumb-- mostly :devil2:

I think it's even more important to learn to write read-able, simple code

Rightly or Wrongly, I normally only read a WS range into an array if I'm computing many times and need the numbers, and write it back if something changed ( = my very personal style)

Since you can't format an array, many times it's just cleaner ( = again IMO) to use the WS range


There's been many discussions here about using arrays vs. cells, but I think it comes down to specific circumstances

[mongoose]

I'm working on implementing the method you are both speaking of. Even if there isn't a speed gain, I want to do it it just for the sake of learning. Speaking of arrays....I am having a lot of trouble working with them and wish I found some material that was more useful than what I've come across thus far.

Specifically, converting this section of code to how Offthelip suggested....



'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 sDate: sDate = Left(Split(oFile.Name, "-")(3), 8)
Dim auditDate As Date
auditDate = CDate(DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 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


Here's my unsuccessful attempt to implement his suggestion...



'Store cells in COL A that have values as a range
Dim arrSOPID As Variant
Dim cel As Range
Dim myStr As String
Dim monthCol As Long
Dim x As Long

'Loop through each SOP audit file
For Each oFile In oFiles
'Strip audit date out of filename and trim off the file extension
Dim sDate: sDate = Left(Split(oFile.Name, "-")(3), 8)
Dim auditDate As Date
auditDate = CDate(DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 3, 2)))

' find last row of active sheet
Dim lastrow: lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' load column A into variant array
arrSOPID = Range(Cells(1, 1), Cells(lastrow, 1))


'Loop through all SOP IDs stored in COL A
For x = 1 To lastrow
myStr = arrSOPID(x, 1)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
' cvalculate column to putthe link in
monthCol = 4 + Month(auditDate)

With ActiveSheet
.Hyperlinks.Add Anchor:=.Range(Cells(x, monthCol), Cells(x, monthCol)), _
Address:=oFile.Path, _
TextToDisplay:="X"
End With
End If
Next x

Next oFile


It was semi-functional after I overcome one barrier after another. Then, it seemed to be only charting them out over one sheet instead of distributing it among the correct sheets. Also, I had a problem trying to do this for the background color etc. I was getting an error with that and couldn't figure out what I was doing wrong.



With ActiveSheet
.Hyperlinks.Add Anchor:=.Range(Cells(x, monthCol), Cells(x, monthCol)), _
Address:=oFile.Path, _
TextToDisplay:="X"
.Interior.Color = RGB(34, 139, 34)
.Font.Color = vbBlack
.Font.Bold = True
End With


Just an update for you all. All the help I've received from you all and the invaluable discussion is bearing fruit. Here's my application so far. I still have a lot more to learn.

24712

[mongoose]

Ok, here is one improvement.



'Clear Worksheets, insert column headings w/formatting
Dim ws As Worksheet
Dim headings As Variant
headings = Array("SOP ID", "DEPT", "SOP TITLE", "LANG", "JAN", "FEB", "MAR", "APR", "MAY", _
"JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC", "GENERATE AUDIT")

For Each ws In ThisWorkbook.Worksheets
ws.Cells.ClearContents
ws.Cells.Interior.Color = xlNone
With ws.Range("A1:Q1")
.Value = headings
.Font.Color = vbBlack
.Font.Bold = True
.Font.Underline = False
End With
Next ws


Works good. I do think there was a slight performance gain. Really want to tackle this part next...my curiosity is killing me as to what I am doing wrong when trying to convert it to using an array. Also, need to modify my switch because some of the dept codes could be assigned to multiple depts. Which would mean putting in a loop but I wonder how big of a hit in speed I'll take from doing that.

[Paul_Hossler]

I'm working on implementing the method you are both speaking of. Even if there isn't a speed gain, I want to do it it just for the sake of learning. Speaking of arrays....I am having a lot of trouble working with them and wish I found some material that was more useful than what I've come across thus far.

http://www.snb-vba.eu/VBA_Arrays_en.html


https://bytecomb.com/arrays-in-vba-part-1-types-of-arrays/


Some references

[mongoose]

Cool, I'll read them, take another stab at it and report back.

[offthelip]

Your code didn't have any loop through the worksheets and in order to format a cell you have to make some reference to is .I have add this to your code


'Store cells in COL A that have values as a range
Dim arrSOPID As Variant
Dim cel As Range
Dim myStr As String
Dim monthCol As Long
Dim x As Long
Dim ws As Worksheet


'Loop through each SOP audit file
For Each oFile In oFiles
'Strip audit date out of filename and trim off the file extension
Dim sDate: sDate = Left(Split(oFile.Name, "-")(3), 8)
Dim auditDate As Date
auditDate = CDate(DateSerial(Right(sDate, 4), Left(sDate, 2), Mid(sDate, 3, 2)))

' find last row of active sheet
Dim lastrow: lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' load column A into variant array
arrSOPID = Range(Cells(1, 1), Cells(lastrow, 1))

For Each ws In ActiveWorkbook.Worksheets
With ws
'Loop through all SOP IDs stored in COL A
For x = 1 To lastrow
myStr = arrSOPID(x, 1)
'See if SOP ID in COL A matches SOP ID in Audit file name
If Trim(RemoveLeadingZeroes(Split(oFile.Name, "-")(2))) = Trim(myStr) Then
'Insert link to audit, change background color, etc of selected cell
' cvalculate column to putthe link in
monthCol = 4 + Month(auditDate)

With ActiveSheet
.Hyperlinks.Add Anchor:=.Range(Cells(x, monthCol), Cells(x, monthCol)), _
Address:=oFile.Path, _
TextToDisplay:="X"
With .Range(.Cells(x, monthCol), .Cells(x, monthCol))
.Value = Headings
.Font.Color = vbBlack
.Font.Bold = True
.Font.Underline = False
End With
End With
End If
Next x
End With
Next ws
Next oFile