I have code that opens a workbook and copies the sheet to the workbook running the code. I know activating is generally bad for speed but I can't figure out how to speed this up anymore. The data area is usually "A1:Q45000" but is different all the time.
Sub AutofillOperations()
Dim answer As Integer, fd As FileDialog, wb1 As Workbook, wb2 As Workbook, FileName As Variant, file As Variant, location As String, filedate As Date, FileMissing As Boolean, filetime As Variant
Set wb2 = ThisWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
location = Range("K7").Value
file = UCase(Dir(location))
FileMissing = True
While (file <> "")
If InStr(file, UCase("Operation")) > 0 Then
filedate = DateValue(FileDateTime(location & file))
If filedate = Date Then
FileName = location & file
Set wb1 = Workbooks.Open(FileName)
wb1.Activate
Cells.Copy
wb2.Activate
Sheet7.Activate
Cells.Select
ActiveSheet.Paste
wb1.Close
Application.CutCopyMode = False
FileMissing = False
GoTo EndWhile
End If
End If
file = UCase(Dir)
FileMissing = True
Wend
EndWhile:
If FileMissing Then
MsgBox "File could not be found, please use dialog to verify" & vbNewLine & "modified date and select file.", vbInformation, "File not found"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialView = msoFileDialogViewList
fd.Filters.Clear
fd.Filters.Add "Excel", "*.xls*"
fd.Filters.Add "Excel", "*.csv"
fd.FilterIndex = 1
fd.AllowMultiSelect = False
fd.InitialFileName = location
fd.Title = "Select All file or Cancel to use pasted data"
answer = fd.Show
If answer = -1 Then
FileName = fd.SelectedItems(1)
Set wb1 = Workbooks.Open(FileName)
wb1.Activate
Cells.Copy
wb2.Activate
Sheet7.Activate
Cells.Select
ActiveSheet.Paste
wb1.Close
Application.CutCopyMode = False
End If
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Sheet1.Activate
Sheet2.Activate
filetime = TimeValue(FileDateTime(location & file))
Range("D11").Value = filedate
Range("D12").Value = filetime
End Sub
1 Answer 1
There are few places you can make this code faster and more efficient.
Most notably, this block (repeated twice):
FileName = location & file
Set wb1 = Workbooks.Open(FileName)
Cells.Copy
wb2.Activate
Sheet7.Activate
Cells.Select
ActiveSheet.Paste
wb1.Close
can be adjusted to this:
Set wb1 = Workbooks.Open(FileName)
Set ws1 = wb1.Worksheets(1) 'make sure to Dim ws1 as Worksheet
With ws1
'this section will grab the last row and column of actual data on the sheet, instead of copying **every** cell
'also assumes headers in column A with no data going past left most column in row 1
Dim lRow as Long, lCol as Long
lRow = .Range("A" & .Rows.Count).End(xlup).Row
lCol = .Cells(1,.Columns.Count).End(xlToLeft).Column
.Range(.Range("A1"),.Cells(lRow,lCol)).Copy wb2.Worksheets("Sheet7").Range("A1") 'change name as needed
.Close True
End With
I'll try to do a more full review later, but have to leave now.