4
\$\begingroup\$

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
200_success
145k22 gold badges190 silver badges478 bronze badges
asked Jun 29, 2016 at 18:14
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

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.

answered Jun 30, 2016 at 21:29
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.