2

I've got a series of ranges I'm copying from separate workbooks into a single sheet. Currently I'm doing this by range copy/paste, but with 3 workbooks it takes forever to update. I want to change this into a single array that can take the used range from each sheet, append it to the array, and then psate the array into my table.

Current code:

Sub UpdateTable()
Dim icounter As Long
Dim x As Workbook 'The book we're in
Dim y As Workbook 'The data from P6
Dim z As Workbook
Dim w As Workbook

Set x = ThisWorkbook

Set y = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6011-Activities.xls")
Set z = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6006-Activities.xls")
Set w = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\MCR4-Activities.xls")


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'Copy-paste the values from the P6 output sheets to the workbook
y.Sheets("TASK").Range("A3:J3000").Copy

x.Sheets("TASKS").Range("A2").PasteSpecial

Application.CutCopyMode = False

z.Sheets("TASK").Range("A3:J300").Copy

x.Sheets("TASKS").Range("A3001").PasteSpecial

Application.CutCopyMode = False

w.Sheets("TASK").Range("A3:J300").Copy

x.Sheets("TASKS").Range("A3300").PasteSpecial

Application.CutCopyMode = False

'Close the output sheets
y.Close
z.Close
w.Close



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

As you can see, it's somewhat messy, and it takes a long time to run (almost a full minute, given the size of the ranges).

The reason I've chosen the ranges to be this large is because I do not know how many items (rows) will be coming out in each worksheet. The columns will always remain the same, but the rows are subject to change.

Thanks

Community
  • 1
  • 1
Dunn
  • 405
  • 1
  • 5
  • 12

4 Answers4

2

Dunn!

If what you want is efficiency, I think there's a better way, optimizing the code you wrote and only copying data that matters; try this code, it will most probably reduce your processing time:

Sub UpdateTable()
Dim icounter As Long
Dim x As Workbook 'The book we're in
Dim y As Workbook 'The data from P6
Dim z As Workbook
Dim w As Workbook

Dim WB As Workbook

Set x = ThisWorkbook

Set y = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6011-Activities.xls")
Set z = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6006-Activities.xls")
Set w = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\MCR4-Activities.xls")


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'Copy-paste the values from the P6 output sheets to the workbook

For Each WB In Application.Workbooks

    WB.Activate

    If WB.Name <> x.Name Then

        If WB.Name = y.Name Or _
           WB.Name = z.Name Or _
           WB.Name = w.Name Then

            WB.Sheets("TASK").Range(Cells(3, 1), Cells(3, 1).SpecialCells(xlLastCell)).Copy
            x.Activate
            x.Sheets("TASKS").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
       Application.CutCopyMode = False

      End If

    End If

Next

'Close the output sheets
y.Close
z.Close
w.Close



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

I tried with approx 3000 rows and it ran in less than 10 secs; just be sure to paste this macro in a module within workbook 'x' and, preferrably, have no other workbook on the same instance, once the macro is executed.

Tell me if you had any luck!

SieluLintu
  • 56
  • 8
  • Hey VBAstard; I tried your code, and found it took just as long to run, only a couple moinutes, but it stops that instance of excel while it's running. I ws hoping that an array operate be faster than this. It did work though, thanks. – Dunn Aug 20 '15 at 16:31
  • I was going through and reviewing, and I found that a few minor changes to my ocde, with your addition, made it run a lot faster, only a few seconds all together! Thanks! – Dunn Aug 25 '15 at 11:13
1

Some tips (which I'd like to put in comment but they are long to explain):

  1. you don't need to Copy >> Past, use Copy [destination] parameter to do the trick:

    y.Sheets("TASK").Range("A3:J3000").Copy x.Sheets("TASKS").Range("A2")

  2. you can find quite precisely range to copy using either .CurrentRegion or .End(xlUp) techniques, samples:

    a) with CurrentRegion assuming your range to copy is continuous and starts in Range("A3"):

    y.Sheets("TASK").Range("A3").CurrentRegion.Copy x.Sheets("TASKS").Range("A2")

    b) with End(xlUp) assuming in Column A you have complete set of data from A3 until last row:

    Dim intLastRowToCopy as integer
    intLastRowToCopy= y.Sheets("TASK").Cells(Rows.Count, "A").End(xlup).Row
y.Sheets("TASK").Range("A3:J" & ntLastRowToCopy).copy x.Sheets("TASKS").Range("A2")
Kazimierz Jawor
  • 18,861
  • 7
  • 35
  • 55
1

Instead of copying the ranges set the ranges equal to the ranges in the newly opened workbook. It should work much faster.

To find the last used row, use this function.

Function ultimaFilaBlanco(col As String) As Long

    Dim lastRow As Long
    With ActiveSheet
        lastRow = ActiveSheet.Cells(1048576, col).End(xlUp).row
    End With

    ultimaFilaBlanco = lastRow

End Function

This will avoid copying empty rows into the array. Source: How to determinate the last Row used in VBA including black space in the rows

Then for each workbook copy the range into seperate arrays. (This will be much faster then trying to append an array. (ReDim..) )

Sub UpdateTable()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'Careful this might prevent the new workbooks from calculating when opened...

Dim icounter As Long
Dim x As Workbook 'The book we're in
Dim y As Workbook 'The data from P6
Dim z As Workbook
Dim w As Workbook

Set x = ThisWorkbook
Set y = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6011-Activities.xls")
Set z = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6006-Activities.xls")
Set w = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\MCR4-Activities.xls")


'set the values from the P6 output sheets to the workbook

x.Sheets("TASKS").Range("A2:J3000 change this to correct size") = y.Sheets("TASK").Range("A3:J3000")
x.Sheets("TASKS").Range("A3001:J3300 change this to correct size") = w.Sheets("TASK").Range("A3:J300")
x.Sheets("TASKS").Range("A3300:J3600 change this to correct size") = z.Sheets("TASK").Range("A3:J300")

'Close the output sheets
y.Close
z.Close
w.Close

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
alphabet5
  • 1,043
  • 1
  • 11
  • 15
1

I recommend a variant of alphabet5's suggestion.

In your master sheet, maintain a reference to the range you will be copying the data to. You will probably want to initialize it like this:

dim dstRange as Range
set dstRange = x.Sheets("TASKS").Range("A1")

though you can change "A1" to whatever cell you want to start outputting at.

Next you will want to create a function GetUsedRange which takes a worksheet and returns a range that covers all of the data in that worksheet. The simplest version would be:

Function GetUsedRange(ByRef ws as WorkSheet) as Range
    Set GetUsedRange = ws.UsedRange
End Function

Note that UsedRange does not have a very good reputation of being correct so I suggest using one of the methods that KazimierzJawor suggested. Look at this SO Q/A for more info.

Now, instead of copying and pasting simply do:

Dim srcRange as Range
' ...
Set srcRange = GetUsedRange(y)
Set dstRange = dstRange.Resize(srcRange.Rows.Count, srcRange.Columns.Count)
dstRange.Value = srcRange.Value
Set dstRange = dstRange.Offset(dstRange.Rows.Count,0)
' ...

Hope this helps! :)

Community
  • 1
  • 1
Michael S Priz
  • 1,116
  • 7
  • 17