Automate creation of charts in multiple excel files? - excel

I just spent a significant amount of time creating identical graphs in several dozen excel files (all containing identically formatted data,) and believe there has to be a more efficient way of completing what I've just done.
To simplify things, consider 50 excel documents with data in the same format. Does there exist a method of automatically:
Creating a simple line graph
Adding axis labels, a chart label, removing horizontal grid lines
Including a trend line/R^2 value
Saving the new workbook to a certain location with "_graphed" appended to the filename
Would this be something that an Excel VBA could be used for?

For this sort of problem I would start by recording a macro of the steps you take manually into a personal macro workbook. You can then look at the code produced by Excel and you may find that you don't need to make too many changes for this to be useful as a generic procedure.
After testing, if you wanted to take the automation one step further you could write a little procedure to loop through all of the Excel files in a directory and call your chart procedure for each file when it is open. I can dig out come code I wrote doing something similar if it will help.
Update
Here is a thread where I have provided some code to loop through all of the files containing some given text (in this example ".pdf" but could just as easily be ".xls" to cover xlsx, xlsm etc).
Also this example prints out a list of the files it finds to a worksheet. This is a good start to test the results, but once this is okay you would need to replace the line:
Range(c).Offset(j, 0).Value = vFileList(i)
With some code to open that workbook and call your code to generate the chart. Let me know if you get stuck.
Further Update
I have reviewed the code referred to above and made a few improvements including an additional parameter for you to specify the name of a macro that you want to run against each of the workbooks opened (that meet the condition specified). The macro that you use in the call must exist in the workbook that you are calling all of the other workbooks from (e.g. if the chart macro is in your personal workbook then the code below should also be placed in your personal macro workbook):
Option Explicit
Sub FileLoop(pDirPath As String, _
Optional pPrintToSheet = False, _
Optional pStartCellAddr = "$A$1", _
Optional pCheckCondition = False, _
Optional pFileNameContains = "xxx", _
Optional pProcToRunOnWb)
On Error GoTo PrintFileList_err
' Local constants / variables
Const cProcName = "FileLoop"
Dim vFileList() As String ' array for file names
Dim i As Integer ' iterator for file name array
Dim j As Integer ' match counter
Dim c As String
' variables for optional param pProcToRunOnWb
Dim vFullPath As String
Dim vTmpPath As String
Dim wb As Workbook
vFullPath = Application.ThisWorkbook.FullName
vFileList = GetFileList(pDirPath)
c = pStartCellAddr
j = 0
For i = LBound(vFileList) To UBound(vFileList)
' if condition is met (i.e. filename cotains text or condition is not required...
If pCheckCondition And InStr(1, vFileList(i), pFileNameContains, vbTextCompare) > 0 _
Or Not pCheckCondition Then
' print name to sheet if required...
If pPrintToSheet Then
Range(c).Offset(j, 0).Value = vFileList(i)
j = j + 1 ' increment row offset
End If
' open wb to run macro if required...
If pProcToRunOnWb <> "" Then
Application.DisplayAlerts = False ' set alerts off so that macro can run in other wb
vTmpPath = pDirPath & "\" & vFileList(i)
Set wb = Workbooks.Open(Filename:=vTmpPath)
Workbooks(wb.Name).Activate
Application.Run "'" & vFullPath & "'!" & pProcToRunOnWb
wb.Close (True) ' save and close workbook
Application.DisplayAlerts = True ' set alerts back on
End If
End If
Debug.Print vFileList(i)
Next i
' clean up
Set wb = Nothing
PrintFileList_exit:
Exit Sub
PrintFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Sub
Function GetFileList(pDirPath As String) As Variant
On Error GoTo GetFileList_err
' Local constants / variables
Const cProcName = "GetFileList"
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim c As Double ' upper bound for file name array
Dim i As Double ' iterator for file name array
Dim vFileList() As String ' array for file names
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(pDirPath)
c = objFolder.Files.Count
i = 0
ReDim vFileList(1 To c) ' set bounds on file array now we know count
'Loop through the Files collection
For Each objFile In objFolder.Files
'Debug.Print objFile.Name
i = i + 1
vFileList(i) = objFile.Name
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
GetFileList = vFileList
GetFileList_exit:
Exit Function
GetFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Function
You can call this from another macro or from the immediate window (ctrl+G) with the parameters required e.g. to get all files containing '.xls', and run a macro named 'your_macro_name_here' the code would be:
call FileLoop("C:\Users\Prosserc\Dropbox\Docs\Stack_Overflow\Test", False, "", True, ".xls", "your_macro_name_here")
Obviously change the path in the first parameter to point to the directory containing the files that you want to run the macro against.

There is a library called Xlsxwriter for both python and perl which allows for the automation of chart generation. For some sample python code, see my post here.

Related

Excel VBA Workbook.Save Method taking >1 minute for changes on only 1 of 3 worksheets

I have a very odd duck problem with Excel VBA. I have a data file that is opened in VBA, written to and then closed. I have three separate worksheets within this same file that are similar but not the same, but none of them contain shapes, or other objects and relatively small amounts of data (usually less than 1000 rows by no more than 30 columns -- mostly numeric constant values) are being pasted into these worksheets. When two of the sheets are modified, it saves lickety split with no issues, but the third worksheet takes in excess of one minute to complete the save operation. The preceding code is almost exactly the same.
Set WBs = ThisWorkbook
Set WSs = WBs.Worksheets("SourceData")
LastRow = WSs.Range("B" & Rows.Count).End(xlUp).Row 'Finds row number of last row of data
Set WBd = OpenWorkbook(FileNam, FullPath:=True)
Set WSd = WBd.Worksheets("TroubledWorksheet")
''' CODE FOR COPYING DATA '''
Set Rng = WSs.Range("A20:AJ" & LastRow + 1)
WSd.Range("A2:AJ" & LastRowD).Clear
Rng.Copy WSd.Range("A2") 'copies all data from source to dest file
WSs.Columns("A:AI").Copy 'copy column width from source
WSd.Columns("A:AI").PasteSpecial Paste:=xlPasteColumnWidths 'paste column width to dest
ActiveWindow.DisplayZeros = False 'hides zeros in cells if formulas output is zero
WSd.Cells.FormatConditions.Delete 'clears Conditional Formatting for entire Sheet
WBd.Activate
WSd.Select
WSd.Range("A1").Select
Application.CalculateBeforeSave = False
' WBd.Save
WBd.Close SaveChanges:=True
Application.CalculateBeforeSave = True
I have uncommented the .Save in the above code with the same effect. I have also removed the .CalculateBeforeSave flags being set, also with no difference.
OpenWorkbook is a helper function that I use to open all of my workbooks.
''' ***************************************************************************
''' * OpenWorkbook()
''' * Preconditions: None
''' * Input: fname - File name
''' * show - boolean to show the workbook after opening
''' * FullPath - Boolean saying wheter it is partial or full path to wb
''' * Readonly - To open as Read Only or not
''' * Output: The Workbook Object
''' * This returns a workbook object of the specified file name. Checks to see
''' * if the Workbook is already open
''' ***************************************************************************
Public Function OpenWorkbook(fname As String, _
Optional show As Boolean = True, _
Optional FullPath As Boolean = False, _
Optional ReadOnly As Boolean = False, _
Optional UpdateLinks As Boolean = False, _
Optional AutoSave As Boolean = False) As Workbook
Dim wb As Workbook
Dim myFileName As String
Dim wbPath As String
Dim aPath() As String
On Error GoTo OpenWorkbookError
'If GEN_DEBUGGING Then Debug.Print "Enter OpenWorkbook #" & TimeInMS
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
wbPath = IIf(FullPath, fname, ReturnPath(fname))
If Right(wbPath, 4) Like "*xls*" Then
myFileName = wbPath
ElseIf Left(fname, 1) = "\" Or Left(fname, 1) = "/" Then
myFileName = wbPath & Mid(fname, 2) 'SelectFile(wbPath)
Else
myFileName = wbPath & fname
End If
On Error Resume Next
aPath = Split(myFileName, Delimeter)
Set wb = Workbooks(aPath(UBound(aPath)))
If wb Is Nothing Then Set wb = Workbooks.Open(myFileName, UpdateLinks:=UpdateLinks, ReadOnly:=ReadOnly)
On Error GoTo OpenWorkbookError
If wb Is Nothing Then
Err.Raise vbObjectError + 514, "Helper.OpenWorkbook", _
"Unable to Open " & myFileName & " Workbook"
Exit Function
Else
On Error Resume Next
wb.AutoSaveOn = AutoSave
On Error GoTo OpenWorkbookError
wb.Windows(1).Visible = show
End If
Set OpenWorkbook = wb
OpenWorkbookExit:
Application.DisplayAlerts = True
On Error GoTo 0
Exit Function
OpenWorkbookError:
MsgBox "Please ensure the workbook you are trying to open is at the specified location: " & _
vbCrLf & fname, vbCritical + vbOKOnly, "Error Opening Workbook"
HandleError "Helper.OpenWorkbook()"
Resume OpenWorkbookExit
End Function
This slow save for only one of the sheets has been observed by other members of my company. I have tried to pause the code before the save and save the workbook manually with the same result of a very prolonged save. Once I have saved it the first time it resumes normal behavior and saves quickly either in code or in the Excel application.
Any pointers or help would be greatly appreciated.
EDIT 1: I've updated the code for more completeness
EDIT 2: There was a similar post here: Too long saving time in Excel via VBA but it resolved itself. The problem I am experience is taking longer and longer. Today it took 11 minutes to save the file. The hangup is only on the .Save everything runs like clockwork right up until that point.
EDIT 3: It appears that some of the time it is now saving quickly and at other times it has continued to act slowly. There is no rhyme or reason behind these differences that I can pinpoint, they all occur when the data file was already created and previously saved, but other than that I am stumped.
EDIT 4: Resurrecting this post because this is becoming a rather serious slow-down in the operation. This behavior is only for Sheet(1) of the 3-sheet workbook, if I save to the other two sheets, this problem is non-existent. If I create a fresh workbook in code (a common occurrence) this problem does not happen, it is only when the data on Sheet(1) is replaced by the new data that we see this problem. Hopefully someone out there has seen something like this.
check your strategy for last row
LastRow = WSs.Range("B" & Rows.Count).End(xlUp).Row 'Finds row number of last row of data
can return ALL the worksheet, provoking lack of performance

Using function to open and update values in external workbooks, but returning source errors

I've been using a function from another StackOverflow question (I'm SO sorry I can't find the original answer!) to help go through a number of cells in Column L that contains a formula that spits our a hyperlinked filepath. It is meant to open each one (workbook), update the values, then save and close the workbook before opening the next one. See below.
Sub List_UpdateAndSave()
Dim lr As Long
Dim i As Integer
Dim WBSsource As Workbook
Dim FileNames As Variant
Dim msg As String
' Update the individual credit models
With ThisWorkbook.Sheets("List")
lr = .Cells(.Rows.Count, "L").End(xlUp).Row
FileNames = .Range("L2:L" & lr).Value
End With
For i = LBound(FileNames, 1) To UBound(FileNames, 1)
On Error Resume Next
If FileNames(i, 1) Like "*.xls*" Then
Set WBSsource = Workbooks.Open(FileNames(i, 1), _
ReadOnly:=False, _
Password:="", _
UpdateLinks:=3)
If Err = 0 Then
With WBSsource
'do stuff here
.Save
.Close True
End With
Else
msg = msg & FileNames(i, 1) & Chr(10)
On Error GoTo 0
End If
End If
Set WBSsource = Nothing
Next i
If Len(msg) > 0 Then
MsgBox "The Following Files Could Not Be Opened" & _
Chr(10) & msg, 48, "Error"
End If
End Sub
The problem now is I am using this to work on a Network drive, and as a result it cause pathing issues with the Connections/Edit Links part. Each of the files are stored on S:\... which as a result of using the Hyperlink formula, won't be able to find the source data. See below the example image of a file that as been opened through a hyperlink cell from my original workbook. When I go to update the Edit Links section of it, it shows these errors.
If I open that lettered drive in Windows Explorer and find the file, it works with no problems. Open, Update Values > Save > Close, it says unknown...
(but if I click Update values here they update correctly.)
If opened using a Hyperlink formula in a cell (Also directing to S:\..) it says it contains links that cannot be updated. I choose to edit links and they're all "Error: Source not found". The location on them also starts off with \\\corp\... and not S:\.
Anyway to fix this? Apologies for the long winded question.
I'm adding this as an answer as it contains code and is a bit long for a comment.
I'm not sure if it's what you're after though.
The code will take the mapped drive and return the network drive, or visa-versa for Excel files. DriveMap is the variable containing the final string - you may want to adapt into a function.
Sub UpdatePath()
Dim oFSO As Object
Dim oDrv As Object
Dim FileName As String
Dim DriveMap As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileName = Range("A1")
If InStr(oFSO.GetExtensionName(FileName), "xls") > 0 Then
For Each oDrv In oFSO.drives
If oDrv.sharename <> "" Then
'Changes \\corp\.... to S:\
If InStr(FileName, oDrv.sharename) = 1 Then
DriveMap = Replace(FileName, oDrv.sharename, oDrv.Path)
End If
'Changes S:\ to \\corp\....
' If InStr(FileName, oDrv.Path) = 1 Then
' DriveMap = Replace(FileName, oDrv.Path, oDrv.sharename)
' End If
End If
Next oDrv
End If
End Sub

Copying base data sheet along with selected sheets from source workbook to new workbook

I am looking at building a master workbook which receives a monthly dump of data for all Cost Centres which will then populate a large number of worksheets within the workbook, and which then need to be split off and sent out to service heads. A service head will receive a selection of worksheets based on the first 4 characters of the sheet name (although this may change in due course).
eg 1234x, 1234y, 5678a, 5678b will produce two new workbooks named 1234 and 5678 with two sheets in each.
I have cobbled some code from various forum to create a macro that will work through a hard coded array defining the service head 4 character codes and create a series of new workbooks. And which seems to work.
However.. I also need to include the main data dump sheet within the source file (called "data") with the the array of files being copied over so that the links remain with the data sheet being copied over. If I write a line to copy over the data sheet separately, the new workbook still refers back to the source file, which service heads do not have access to.
So main question is: how can I add the "data" tab into the Sheets(CopyNames).Copy code so it is copied over with all the other files in the array at the same to keep the links intact?
Second question is if I decide it is the first two characters of the worksheet define the sheets that relate to a service head, how do I tweak the split/mid line of code - I've trialled around but am getting tied up in knots!
Any other tips to make the code more elegant much appreciated (there may be quite a long list of service head codes and I am sure there is a better way of creating a list for the routine to loop through)
Sub Copy_Sheets()
Dim strNames As String, strWSName As String
Dim arrNames, CopyNames
Dim wbAct As Workbook
Dim i As Long
Dim arrlist As Object
Set arrlist = CreateObject("system.collections.arraylist")
arrlist.Add "1234"
arrlist.Add "5678"
Set wbAct = ActiveWorkbook
For Each Item In arrlist
For i = 1 To Sheets.Count
strNames = strNames & "," & Sheets(i).Name
Next i
arrNames = Split(Mid(strNames, 2), ",")
'strWSName =("1234")
strWSName = Item
Application.ScreenUpdating = False
CopyNames = Filter(arrNames, strWSName, True, vbTextCompare)
If UBound(CopyNames) > -1 Then
Sheets(CopyNames).Copy
ActiveWorkbook.SaveAs Filename:=strWSName & " " & Format(Now, "dd-mmm-yy h-mm-ss")
ActiveWorkbook.Close
wbAct.Activate
Else
MsgBox "No sheets found: " & strWSName
End If
Next Item
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub CopySheets()
With ThisWorkbook
Dim SheetIndex As Long
Dim ValidSheetNames() As String
ReDim ValidSheetNames(1 To .Worksheets.Count)
' Build a 1 dimensional array called ValidSheetNames, which contains every sheet in the master workbook other than DEDICATEDSHEET. '
Dim ws As Worksheet
For Each ws In .Worksheets
If ws.Name <> "DEDICATEDSHEET" Then
SheetIndex = SheetIndex + 1
ValidSheetNames(SheetIndex) = ws.Name
End If
Next ws
ReDim Preserve ValidSheetNames(1 To SheetIndex)
' Read all ServiceCodes into a 1-dimensional array '
Dim ServiceHeadCodes As Variant
ServiceHeadCodes = Application.Transpose(.Worksheets("DEDICATEDSHEET").Range("CCLIST[CC]").Value2)
Dim CodeIndex As Long
' Now loop through each ServiceHeadCode '
For CodeIndex = LBound(ServiceHeadCodes) To UBound(ServiceHeadCodes)
' Put all sheet names which contain the current ServiceHeadCode into an array called SheetsToCopy '
Dim SheetsToCopy() As String
SheetsToCopy = Filter(ValidSheetNames, ServiceHeadCodes(CodeIndex), True, vbTextCompare)
' Check if SheetToCopy now contains any sheet names at all. '
If UBound(SheetsToCopy) > -1 Then
' Add the name of the Data sheet to the end of the array '
ReDim Preserve SheetsToCopy(LBound(SheetsToCopy) To (UBound(SheetsToCopy) + 1))
SheetsToCopy(UBound(SheetsToCopy)) = "Data"
Dim OutputWorkbook As Workbook
Set OutputWorkbook = Application.Workbooks.Add
' Copy all sheets which are in SheetToCopy array to newly created OutputWorkbook '
.Worksheets(SheetsToCopy).Copy OutputWorkbook.Worksheets(1)
' Delete the default Sheet1, which should be at the end as copied sheets were inserted before it. '
' But suppress the Are you sure you want to delete this sheet.. message. '
Application.DisplayAlerts = False
OutputWorkbook.Worksheets(OutputWorkbook.Worksheets.Count).Delete
Application.DisplayAlerts = True
' Re-enable alerts, as we want to see any other dialogue boxes/messages
' Not providing a full directory path below means OutputWorkbook will be saved wherever Thisworkbook is saved.'
OutputWorkbook.SaveAs Filename:=ServiceHeadCodes(CodeIndex) & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx", FileFormat:=51
OutputWorkbook.Close
Else
MsgBox "No sheets found: " & ServiceHeadCodes(CodeIndex)
End If
Next CodeIndex
End With
End Sub
Untested and written on mobile, sorry for bad formatting.
This approach proposes that you store all service head codes in a 1-column Excel table on a dedicated sheet that is referred to via Excel table nomenclature (which might be easier than ArrayList.Add for each new service head code).
I assume code is stored in master workbook ('thisworkbook'), which might not be true.
You could modify the serviceheadcodes table directly on the spreadsheet itself, if you later decide that SheetsToCopy will be determined by first 2, 3 or X characters -- or you could modify array itself with left$() function.
Hope it works or gives you some ideas.
Edit: This is my sheet and table layout (which I assume matches yours).
And this is what the code above gives me on my computer.

cannot retrieve column titles from another workbook

I am trying to copy the string values(column titles) from another workbook in row 4 as captions for checkboxes in the workbook where I am running the code. This is what I have so far and it is not working because it is showing the error message "Subscript out of range, run time error 9" Here is what I have. After the error message pops up the line marked below is highlighted. Can anybody help me please. Thank you very much.
Function CallFunction(SheetName As Variant) As Long
Dim text As String
Dim titles(200) As String ' Dim titles(200) As String ' Array
Dim nTitles As Integer
Dim wks As Worksheet
Dim myCaption As String
PathName = Range("F22").Value
Filename = Range("F23").Value
TabName = Range("F24").Value
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=PathName & "\" & Filename
ActiveSheet.Name = TabName
Set wks = Workbooks("Filename").Worksheets(SheetName).Activate ' <= Highlights this line ****
For i = 1 To 199
If Trim(wks.Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = wks.Cells(4, i).Value
Next
i = 1
For Each cell In Range(Sheets("Sheet1").Cells(4, 1), Sheets("Sheet1").Cells(4, 1 + nTitles))
myCaption = Sheets("Sheet1").Cells(4, i).Value
With Sheets("Sheet1").checkBoxes.Add(cell.Left, _
cell.Top, cell.Width, cell.Height)
.Interior.ColorIndex = 12
.Caption = myCaption
.Characters.text = myCaption
.Border.Weight = xlThin
.Name = myCaption
End With
i = i + 1
Next
End Function
Subscript out-of-range typically indicates that a specified Worksheet does not exist in the workbooks Worksheets collection.
Otherwise, are you sure that the workbook specified by FileName is already open? If not, that will raise the same error.
Ensure that A) the file is already open (or use the Workbooks.Open method to open it), and B) ensure that such a worksheet already exists (if not, you will need to create it before you can reference it by name).
Update
You have Workbooks("FileName") where "Filename" is a string literal. Try changing it to simply Filename (without the quotation marks) (this seems like the OBVIOUS error).
Also worth checking:
I also observe this line:
ActiveSheet.Name = TabName
If the sheet named by SheetName is active when the workbook opens, then that line will effectively rename it, so you will not be able to refer to it by SheetName, but instead you would have to refer to it by Worksheets(TabName). ALternatively, flip the two lines so that you activate prior to renaming:
Set wks = Workbooks(Filename).Worksheets(SheetName).Activate
ActiveSheet.Name = TabName
For further reading: avoid using Activate/Select methods, they are confusing and make your code harder to interpret and maintain:
How to avoid using Select in Excel VBA macros
If that is the case, then you could do simply:
Workbooks(Filename).Worksheets(SheetName).Name = TabName

VBA Excel - Faster Execute - Copy Sheet (with charts/objects) from closed file

I am hoping to find a way to help this code run faster; so this is the path im following to try and achieve this -
current time - 23 seconds, most of it opening & closing files.
So I am attempting to pull data from files without opening them.
I've seen Microsoft.ACE.OLEDB.12.0 but I have not idea how to use it to get the entire sheet, warts and all.
I've seen a lot of solutions that pull data from cells and gets sheet names -
I want my entire sheet, all objects on that sheet, its headers, footers, everything.
This is the macro I'd like to apply it to:
Sub DirPDF_Long_Sections(LongFolderPath As String)
' ####################################################################################
' # INTRO
'-------------------------------------------------------------------------------------
' Purpose
' This procedure assists the user to put all long sections from a folder into one
' PDF file. This makes it convieniet to share the long sections & print them.
'
' THIS PROCEDURE USES DIR instead of FSO
'
' ####################################################################################
' # DECLAIRATIONS
'-------------------------------------------------------------------------------------
' OBJECTS
Dim LongFolder As String
Dim LongFile As String
Dim OpenLong As Workbook
Dim ExportWB As Workbook
'Dim FileSystemObj As New FileSystemObject
'-------------------------------------------------------------------------------------
' VARIABLES
Dim count As Long
Dim DefaultPrinter As String
Dim DefaultSheets As Variant
Dim FirstSpace As Long
Dim LastSpace As Long
Dim start_time, end_time
' ####################################################################################
' # PROCEDURE CODE
'-------------------------------------------------------------------------------------
' optimise speed
start_time = Now()
Application.ScreenUpdating = False
'-------------------------------------------------------------------------------------
' Print the Files in the Folder:
DefaultSheets = Application.SheetsInNewWorkbook '// save default setting
Application.SheetsInNewWorkbook = 1 '// create a one worksheet workbook
Set ExportWB = Workbooks.Add
Application.SheetsInNewWorkbook = DefaultSheets '// re-set application to default
LongFile = Dir(LongFolderPath & "\*PipeLongSec*", vbNormal)
While LongFile <> vbNullString '// loop through all the files in the folder
FirstSpace = InStr(1, LongFile, " ") '// record position of first space character
LastSpace = InStr(FirstSpace + 1, LongFile, " ") '// record position of last space character
Set OpenLong = Workbooks.Open(LongFile) '// open the file
OpenLong.Sheets("Long Sections").Copy After:=ExportWB.Sheets(ExportWB.Sheets.count)
'// copy sheet into export workbook
ExportWB.Sheets(ExportWB.Sheets.count).Name = Mid(LongFile, FirstSpace + 1, LastSpace - FirstSpace - 1)
'// rename sheet we just moved to its pipe number
OpenLong.Close '// close the file
LongFile = Dir() '// get next file
Wend
'-------------------------------------------------------------------------------------
' Delete the other worksheet in the temporary workbook
Application.DisplayAlerts = False
ExportWB.Sheets("Sheet1").Delete
Application.DisplayAlerts = True
'-------------------------------------------------------------------------------------
' Send Workbook to PDF - in save location
ExportWB.ExportAsFixedFormat xlTypePDF, LongFolderPath & "\" & "LongSectionCollection " & Replace(Date, "/", "-")
ExportWB.Close SaveChanges:=False
'#####################################################################################
'# END PROCEDURE
Application.ScreenUpdating = True
Set OpenLong = Nothing
end_time = Now()
MsgBox (DateDiff("s", start_time, end_time))
End Sub
Add Option Explicit before any code at the top
Convert DefaultSheets to CLngPtr(DefaultSheets)
Convert Long data types to CLngPtr(variable)
Convert to CDate(Start_Time)
Convert to CDate(End_Time)
No worries. They should be defined in the dim statement if they would remain the same data type. If this data type changes throughout the code then use as variant in the dim statement and use the conversion functions found in the object browser to convert the data types as needed.

Resources