Hi all, below is the macro I've been working on, and it seems to work, but takes a long time... I had anticipated it would based on what I'm asking it to do with pdf files and the sheer size of the workbook, as well as all the formulae and calculations within the workbook. So I'm not trying to make it faster than it can be, just want to make sure I'm not making it slower than it should be with the code I've written/compiled from others much smarter than myself! 
Aslo, the variables that start with x and end with $... I found other code that used these and decided they might work for me, but I have no idea if they are ideal... they are unknowns to me.
I have not attached a copy of the workbook because it is huge (9MB) and 9 WS's and I'd have to do A LOT of sanitizing so I thought I'd throw the code up, maybe there's something obvious I could change to optimize it? Also, is there anything I could do to the workbook, like turn off all calculations so that it's more static through this process and then goes back to a dynamic state on next open or something? Maybe it's all the lookups, and array formulas in the worksheets that are contributing to the slowness... Two of the worksheets have lots of data, 10,000 rows or more and the other sheets perform various analysis and present this data in various ways... can't really do too much about the size of these besides deleting a few columns that are probably not necessary and possibly cutting out a few thousand rows... would doing that make much of a difference?
Thanks,
Joe
Aslo, the variables that start with x and end with $... I found other code that used these and decided they might work for me, but I have no idea if they are ideal... they are unknowns to me.
Code:
Option Explicit
Sub CopyTemplate()
Dim LastRw As Long
Dim FileRef As String
Dim sh As Shape
Dim i As Long
Dim FldrRoot As String
Dim FldrLvl1 As String
Dim FldrLvl2 As String
Dim FldrLvl3 As String
Dim IPDF As Object
Dim Filename As String
Dim PDFRef As String
Dim SubjectRow As Long
Dim xDirect2015PVS$, xDirect2014PVS$, InitialFoldr$
'''// This section prompts the user to define the variables xDirect2015PVS$ and xDirect2014PVS$, which are folder locations that the macro will import PDF objects from at a later point\\\
'''// This is intended to reduce potential naming errors as users will be required to create and populate these folders in advance\\\
InitialFoldr$ = "H:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the folder containing the PVS's for the Roll Year under Appeal"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect2015PVS$ = .SelectedItems(1) & "\"
Else
End If
End With
InitialFoldr$ = "H:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the folder containing the PVS's for the PREVIOUS Roll Year"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect2014PVS$ = .SelectedItems(1) & "\"
Else
End If
End With
Application.ScreenUpdating = False '//Turn off screen updating, stops the screen flickering and generally speeds up the macro\\
'//Location to save completed folders and files\\
FldrRoot = "H:\SF PAAB\Back up files\Macro test" '//Will be setting this variable to be defined by promptig user input\\
LastRw = Sheets("DO NOT DELETE").Range("B" & Rows.Count).End(xlUp).Row '//find last used row in column B\\
For i = 2 To LastRw '//Loop through each row\\
On Error Resume Next
SubjectRow = Sheets("DO NOT DELETE").Range("A" & i).Value '//Couldn't get application.match to work so added helper column with match formula to reference the subject row in the equity sheet\\
On Error GoTo 0
If SubjectRow > 0 Then
Sheets("Equity").Activate
ActiveSheet.Range("A" & SubjectRow).Value = "Y" '//Put the Subject value Y in \\
ActiveSheet.Rows(SubjectRow).Select
Selection.Font.Bold = True 'applies formatting to subject row
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
FileRef = Sheets("DO NOT DELETE").Range("B" & i).Text '//FileRef is the Appeal Number, which is also the folder tree as a string...\\
'//This part defines the folder names and order from the FileRef string...\\
FldrLvl1 = Left(FileRef, 4) '//Extract first 4 characters from string\\
FldrLvl2 = Mid(FileRef, 6, 2) '//Extract middle 2\\
FldrLvl3 = Right(FileRef, 5) '//Extract last 5\\
'//This part creates the folders and file structure\\
On Error Resume Next '//if folder exists - igonore error and carry on\\
MkDir (FldrRoot & "\" & FldrLvl1) '//Create Level 1 folder (eg; 2015)\\
MkDir (FldrRoot & "\" & FldrLvl1 & "\" & FldrLvl2) '//Create Level 2 folder (eg; 14)\\
MkDir (FldrRoot & "\" & FldrLvl1 & "\" & FldrLvl2 & "\" & FldrLvl3) '//Create Level 3 folder (eg; 00002)\\
On Error GoTo 0 '//resume errors\\
'// This next section searches two folders, for files matching variable "Filename:=xDirect2015PVS$ & PDFRef"
'// When found it basically copies and pastes the first page of the PDF file, from each folder to each worksheet... 2015 and 2014 for example
'Probably need to put some error handling in here if the sheet name doesn't match, or get user to define sheet name variables...\\
For Each sh In Sheets(Year(Date) - 1 & " PVS").Shapes '//Find any current PDF pictures in the sheet\\
sh.Delete '//Delete them :-)\\
Next sh
'Probably need to put some error handling in here if the sheet name doesn't match, or get user to define sheet name variables...\\
For Each sh In Sheets(Year(Date) - 2 & " PVS").Shapes '//Find any current PDF pictures in the sheet\\
sh.Delete '//Delete them :-)\\
Next sh
PDFRef = Sheets("DO NOT DELETE").Range("K" & i).Text
'//Is this the most efficient way to do this?\\
Set IPDF = Sheets(Year(Date) - 1 & " PVS").OLEObjects.Add(Filename:=xDirect2015PVS$ & PDFRef, Link:=False, DisplayAsIcon:=False) '//Insert PDF, see Explanations sheet\\
With IPDF
.Top = Sheets(Year(Date) - 1 & " PVS").Range("A1").Top '//Set the top to be cell A1\\
.Left = Sheets(Year(Date) - 1 & " PVS").Range("A1").Left '//Set the left to be cell A1\\
End With
On Error Resume Next '//if file exists - igonore error and carry on\\
Set IPDF = Sheets(Year(Date) - 2 & " PVS").OLEObjects.Add(Filename:=xDirect2014PVS$ & PDFRef, Link:=False, DisplayAsIcon:=False) '//Insert PDF\\
With IPDF
.Top = Sheets(Year(Date) - 2 & " PVS").Range("A1").Top '//Set the top to be cell A1\\
.Left = Sheets(Year(Date) - 2 & " PVS").Range("A1").Left '//Set the left to be cell A1\\
End With
On Error Resume Next '//if file exists - igonore error and carry on\\
'// This next part saves a copy of the workbook in the appropriate folder and then clears some formatting before repeating the process for each record in the loop\\
Filename = Sheets("DO NOT DELETE").Range("F" & i).Text & " Summary Template.xlsm" '//Define the file name from column F\\
ActiveWorkbook.SaveCopyAs (FldrRoot & "\" & FldrLvl1 & "\" & FldrLvl2 & "\" & FldrLvl3 & "\" & Filename) '//Save copy of the workbook\\
'NOTE !!! If the file already exists it will be overwritten !!!
On Error GoTo 0 '//resume errors\\
Sheets("Equity").Activate
Sheets("Equity").Range("A" & SubjectRow).Value = "" '//remove the Y for your calculations\\
Rows(SubjectRow).Select '//clears formatting of subject row\\
Selection.Font.Bold = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next
Application.ScreenUpdating = True '//Turn screen updating back on\\
MsgBox ("Excel has finished!")
End SubI have not attached a copy of the workbook because it is huge (9MB) and 9 WS's and I'd have to do A LOT of sanitizing so I thought I'd throw the code up, maybe there's something obvious I could change to optimize it? Also, is there anything I could do to the workbook, like turn off all calculations so that it's more static through this process and then goes back to a dynamic state on next open or something? Maybe it's all the lookups, and array formulas in the worksheets that are contributing to the slowness... Two of the worksheets have lots of data, 10,000 rows or more and the other sheets perform various analysis and present this data in various ways... can't really do too much about the size of these besides deleting a few columns that are probably not necessary and possibly cutting out a few thousand rows... would doing that make much of a difference?
Thanks,
Joe
