# Excel VBA macro loops through 20-28 sheets taken from filenames in cells and pastes them to the main workbook

My apologies for a "repost", my original post was only partial and confusing. Here is a better snippet. This runs fairly slow (30 seconds or so) cycling through 20 workbooks. Any suggestions for improvement would be appreciated; I have left out my dimming of variables at the beginning, as well as my error handling portions, as those all work just fine.

For even MORE details, the user enters file paths into a column of up to 28 filepaths, and then the adjacent column derives the file name from the path. This macro, once initiated via a command button, begins cycling through all those filepaths, opening the document, copying and pasting it to the main workbook, until it reaches an empty cell in the column, to which then it stops.

There are also a few other small parts in there, like updating the last modified date when the button is clicked, as well as taking information from the first opened sheet to let the user know (on the main page) what kind of information is being pulled or has been pulled. Additionally, I often include frequent status bar updates for my impatient users who don't like staring at a spinning cursor without being told what's going on.

Private Sub CommandButton19_Click()

Application.DisplayStatusBar = True
Application.ScreenUpdating = False 'run faster
Application.DisplayAlerts = False 'prevents clipboard prompt
Application.Cursor = xlWait

On Error GoTo HandleIt

Dim RangeDifferentiator As Integer
Dim i As Long
Dim SheettoCopyLoop
Dim FileToCopyLoop
Dim FileNameLoop

For i = 1 To 28 'start loop (28 because the last row being used is 34. If we need more rows this needs to change)

RangeDifferentiator = i + 5
SheettoCopyLoop = Range("D" & RangeDifferentiator)
FileToCopyLoop = Range("E" & RangeDifferentiator)
FileNameLoop = Range("F" & RangeDifferentiator)

If FileToCopyLoop <> "" Then

Application.StatusBar = "Pulling data for " & SheettoCopyLoop & "..." 'let's us know which one it's pulling
Sheets(SheettoCopyLoop).Cells.ClearContents
Workbooks.Open Filename:= _
FileToCopyLoop
'Needs optimizing
Sheets("Summary").Cells.Copy

'Establishes if this is a MTD or YTD file and up to what month it's pulling
If i = 1 Then
Workbooks("YTD File.xlsm").Sheets("SM Summaries").Range("C2").Value = ActiveWorkbook.Sheets("Summary").Range("C6").Value
Workbooks("YTD File.xlsm").Sheets("SM Summaries").Range("C4").Value = ActiveWorkbook.Sheets("Summary").Range("C5").Value
End If

'Needs optimizing
Windows("YTD File.xlsm").Activate
Sheets(SheettoCopyLoop).Select
Sheets(SheettoCopyLoop).Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
Windows(FileNameLoop).Close
Range("A1").Select

Else
Application.ScreenUpdating = True
Application.Cursor = xlDefault
MsgBox "Data pull complete!", vbInformation, "Success!"
Exit Sub
End If

Next i
Exit Sub

'The following is all error handling to help show what went wrong and where
HandleIt:
If SheettoCopyLoop <> "" Then
errorhandler = MsgBox("Oops! An error has occured on page " & SheettoCopyLoop & ". Check to make sure file exists/file path is correct.", vbExclamation, "Error!")
Application.StatusBar = "Error occured on page " & SheettoCopyLoop 'Show where error occured on status bar if applicable
Else
errorhandler = MsgBox("Oops! An unknown error has occured.", vbCritical, "Error!")
Application.StatusBar = "Unknown error"
End If
Range("H7").Select
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Exit Sub
End Sub


I'm not sure why it takes 30 seconds to process the 20 files, because with my almost empty test files, your code only takes 2.202 seconds (21 files). I'm guessing those files are quite large, contain a lot of objects, charts, data (?)

If they have a lot of rows I'd suggest changing them to the xlsb format, which will compress them quite a bit (size could go down to 40%), and they will be a lot faster to open and close

XLSB Format

XLSB is the Excel binary format. It is structured as a compressed folder that contains a large number of binary files. It is much more compact than the XLS format, but the amount of compression very much depends on the contents of the workbook. For example, ten workbooks show a size reduction factor ranging from two to eight with an average reduction factor of four...

Another consideration is that interacting with files over the network is considerably slower than the local drive

Related to the code, there are a few basic issues:

• To properly replace the select statements you need to refer to all objects explicitly:

Windows("YTD File.xlsm").Activate
Sheets(SheettoCopyLoop).Select
Sheets(SheettoCopyLoop).Range("A1").Select
ActiveSheet.Paste


use:

Windows("YTD File.xlsm").Sheets(SheettoCopyLoop).Range("A1").Paste


• Indent your code to make it easier to read, and distinguish hierarchies of logic and nesting
• It's better to prevent all errors than to rely on the "On Error GoTo" statements
• There are few errors that cannot be avoided
• The GoTo statement breaks the flow and structure of the code
• Turn off Application.Calculation (to manual) if possible
• Don't force the user to dismiss dialog boxes after every iteration
• They only need to be aware if their task cannot be completed

I made some changes, such as copying the entire sheets to the main Workbook, instead of copying only the data, so here is how I would change your code:

Option Explicit

Private Sub CommandButton19_Click2()
Dim wb As Workbook, ws As Worksheet, newWB As Workbook
Dim wsSMS As Worksheet, wsS As Worksheet, wsNew As Worksheet
Dim fileInfo As Variant, sheetToCopy As String, r As Long
Dim fileToCopy As String, fileName As String, t As Double

t = Timer

OptimizeXl True, xlWait

Set wb = ThisWorkbook
Set wsSMS = wb.Worksheets("SM Summaries")

fileInfo = ws.Range("D6:F34").Value2

For r = 1 To UBound(fileInfo)               'max xl sheet name length = 31 chars
sheetToCopy = Left(fileInfo(r, 1), 31)  'column 1 of Range("D6:F34") (Col D)
fileToCopy = fileInfo(r, 2)             'column 2 of Range("D6:F34") (Col E)
fileName = fileInfo(r, 3)               'column 3 of Range("D6:F34") (Col F)

'Continue only if all necessary file details are not empty
If Len(fileToCopy) > 0 And Len(sheetToCopy) > 0 And Len(fileName) > 0 Then
If Len(Dir(fileToCopy)) > 0 Then    'continue only if file exists
Application.StatusBar = "Pulling data for " & fileName & "..."

If WsExists(newWB, "Summary") Then
'Delete existing sheet named "sheetToCopy"
If WsExists(wb, sheetToCopy) Then wb.Worksheets(sheetToCopy).Delete
Set wsS = newWB.Worksheets("Summary")
If r = 1 Then
wsSMS.Range("C2").Value = wsS.Range("C6").Value
wsSMS.Range("C4").Value = wsS.Range("C5").Value
End If
'Copy new sheet into this workbook, and rename it to "sheetToCopy"
wsS.Copy After:=wb.Worksheets(wb.Worksheets.Count)
Set wsNew = wb.Worksheets(wb.Worksheets.Count)
wsNew.Name = sheetToCopy
Else
Debug.Print "Invalid sheet name for file on row " & r
End If
newWB.Close False
Else
Debug.Print "Invalid fileToCopy on row " & r & " (" & fileToCopy & ")"
End If
Else
Debug.Print "Empty fileToCopy, sheetToCopy, or fileName on row " & r
End If
Next
ws.Activate
OptimizeXl False
Debug.Print "V2 Time: " & Format(Timer - t, "0.000") & " sec"
MsgBox "Data pull complete!", vbInformation, "Success!"
End Sub


Private Sub OptimizeXl(ByVal stat As Boolean, Optional ByVal curs As Long = xlDefault)
Application.Calculation = IIf(stat, xlCalculationManual, xlCalculationAutomatic)
Application.ScreenUpdating = Not stat
Application.Cursor = curs
End Sub

Private Function WsExists(ByRef wb As Workbook, ByVal wsName As String) As Boolean
Dim ws As Worksheet
If Not wb Is Nothing Then
If Len(wsName) > 0 Then
For Each ws In wb.Worksheets
If ws.Name = wsName Then
WsExists = True
Exit Function
End If
Next
End If
End If
End Function


Test results:

V1 Time: 2.202 sec (your code)
V2 Time: 1.012 sec

• Was just able to view this now, very helpful, thank you very much! I had actually started using Option Explicit about a month ago, I didn't include it here... Wish I had known more about that when I was writing hundreds of pages in Word VBA and running into errors all the time... One thing I must say, though, is I'm very adamant about keeping in dialog boxes for after all interactions. Why? Because my users aren't always tech savvy, and if they click a button and aren't told what happened, they might think it just doesn't work and try clicking it again. I keep those there for guidance. – dwirony Jul 26 '17 at 15:01