Consolidating several Excel sheets into one

I wrote a macro that is taking 20+ minutes to run on other computers, but when I run it on mine it only takes 5 mins. It is a larger macro and I am new to the VBA coding world. I was wondering if I could condense it down so that it can run faster not only for my computer but other computers too.

The purpose of my macro is to take multiple sheets in one workbook and consolidate them into one sheet in the same workbook that I titled as "Consolidated". A problem with the Excel file is that some columns are left blank or the title of the columns are different from other sheets that I am copying and pasting to the master sheet, so I added an iferror to sheets that have blank cells so that I can use the end down function in the final part of the macro where I copy each column from each sheet into the master consolidation sheet. If you need to explain better please let me know.

Sub Macro1()
Dim i As Integer
Dim r As Long, c As Long

Application.ScreenUpdating = False

Sheets("CIP Summary").Select

ActiveSheet.Name = "Consolidated"
ActiveCell.FormulaR1C1 = "Company"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Location"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Store"
Range("D1").Select
ActiveCell.FormulaR1C1 = "RCT/Voucher"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Vendor"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Vendor Name"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Reference"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Period"
Range("K1").Select
ActiveCell.FormulaR1C1 = "JE"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Project"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Expected Open Date"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Comment"
Range("N1").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Font.Bold = True

For i = 15 To Worksheets.Count

For c = 1 To 14
For r = 5 To 1000
If IsError(Sheets(i).Cells(r, c)) Then
Sheets(i).Cells(r, c).Value = "N/A"
ElseIf Sheets(i).Cells(r, c) = "" Then
Sheets(i).Cells(r, c).Value = "N/A"
End If
Next r
Next c
Next i

Dim xWs As Worksheet
Dim Rng As Range
Dim lastRow As String
Dim myPath As String

'company
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Company", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("A1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Company", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'location
Sheets(15).Select
Set Cell = Range("A1:N4").Find("location", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("B1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("location", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'Store
Sheets(15).Select
Set Cell = Range("A1:N4").Find("store", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("C1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("store", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'RCT
Sheets(15).Select
Set Cell = Range("A1:N4").Find("RCT", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("D1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("RCT", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'Vendor
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Vendor", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("E1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Vendor", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'Vendor Name
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Vendor Name", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("F1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("Vendor Name", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'Date
Sheets(15).Select
Set Cell = Range("A1:N4").Find("date", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("g1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("date", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'Reference
Sheets(15).Select
Set Cell = Range("A1:N4").Find("reference", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("H1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("reference", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'amount
Sheets(15).Select
Set Cell = Range("A1:N4").Find("amount", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("I1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("amount", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'period
Sheets(15).Select
Set Cell = Range("A1:N4").Find("period", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("J1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("period", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'JE
Sheets(15).Select
Set Cell = Range("A1:N4").Find("JE", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("K1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("JE", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'project
Sheets(15).Select
Set Cell = Range("A1:N4").Find("Project", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("L1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("project", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'expected open date
Sheets(15).Select
Set Cell = Range("A1:N4").Find("expected", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("M1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("expected", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

'comment
Sheets(15).Select
Set Cell = Range("A1:N4").Find("comment", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Range("N1").Select
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlDown)).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

For i = 16 To Worksheets.Count

Sheets(i).Select
Set Cell = Range("A1:N5").Find("comment", LookAt:=xlPart)
Cell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Consolidated").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next i

End Sub

• You told us what you would like us to do, but not what the purpose of your code is. Please edit your title to summarize what your code is doing. Apr 25, 2019 at 19:26
• Thanks @MathieuGuindon ! i will correct now ! Apr 25, 2019 at 19:29
• Thanks for updating - I mostly meant that for the title though =) Apr 25, 2019 at 19:37
• This SO Q&A should help. Apr 25, 2019 at 19:38
• My 30 second glance (don't have time for a review at the moment) - your three biggest issues are: Active/Select (should not use), iterating through Excel objects instead of arrays (this will give the biggest time saving), and repeated loops (DRY- Don't Repeat Yourself).
– AJD
Apr 25, 2019 at 20:22

This code provides a large number of rookie errors. I suspect, looking at the code, is that it was initially developed from a recorded macro (or two).

In summary, the issues to be addressed are:

• No Option Explicit - you use Cell as a variable in the code which has not been declared
• Variable names have no real meaning
• You Select/Activate and do not use qualified names
• You have sections of code that is very repetitive
• You have loops that reference Excel objects, meaning that the VBA engine keeps switching to the Excel engine and back again - very expensive
• Remember to turn ScreenUpdating back on!

Option Explicit

Always use Option Explicit. This helps avoid typos (r1 instead of rl, anyone?) which leads to undeclared variables using default values, which in turn leads to strange results that are hard to track down. In addition, it help enforce strong type discipline and enables the debugger to provide more meaningful error messages (relatively speaking!).

Meaningful variable names

Using meaningful variable names results in code that requires less comments and is easer to maintain. Some examples:

• r could mean anything, but rowCounter provides a visual clue that this is used as a counter or in a loop.
• i is a standard loop iterator, but what are we iterating? worksheetCounter is similarly self-documenting.
• c could be columnCounter
• Cell has the double danger of being a reserved word and an object in Excel. Using this as a variable name can lead to confusion. Perhaps sourceToCopy is more meaningful in this context?

Avoiding Select and Active[thingys]

As noted in the comments, this StackOverflow answer provides some good guidance on avoiding select: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba/10717999#10717999.

Selecting things slows the code down by forcing screen updates that are not necessary. Select in itself is not otherwise dangerous in code - just unnecessary and slow.

Using the Active Book/Sheet/Cell, however is very dangerous in code. In addition, every time you use an unqualified range, you are implicitly using the active range object (book, sheet, cell). As a coder, you have very little control over what is active - you could be running other code that switches the active thing. The user could be doing things and switching while the code is running. Excel itself could for some unknown reason jump to another [thing] and make it active.

Don't repeat yourself (DRY)

I am lazy programmer. If I have to write the same code twice, I think it is too much work and I can address the repetition in two ways: in a loop or in a routine (with parameters!).

You have globs of code where the code is simple a cut and paste of previous stuff. If you ever wanted to adjust the code, you now have to do it in umpteen places and "London to a brick", you would miss one piece of repeated code and spend ages trying to figure out why you are getting bad results (or even worse, getting bad results and believing they are good).

Excel objects versus VBA objects

I don't want to get too technical here, there are others who can explain this much better than me. I think of this simply as having two object engines. There is a VBA engine and an Excel engine. VBA code uses the VBA engine, and the Excel specific objects (cells, sheets, workbooks, application formulas to name a few) use the Excel engine.

This is all fine and good, except that to switch between the two engines takes computing time and effort. And a relatively large amount of it. So in a loop like below, the system will switch engines 10,000 times (and that is without the effort to do calculations)

For myIterator = 1 to 5000
Debug.Print myWB.Range("A" & CStr(myIterator)).Value
next myIterator


Whereas ...

myValues = myWB.Range("A1:A5000").Value ' myValues is a Variant type
For myIterator = 1 to 5000
Debug.Print myValues(myIterator,1)
' two dimensional array because this is how the values are converted.
next myIterator


...is much more switch friendly.

What does this mean?

Here is a look at your code with the above points addressed.

Option Explicit

Sub ConsolidateData() ' more meaningful name

Application.ScreenUpdating = False  ' Use proper indenting.

Dim consolidatedWorksheet As Worksheet
Set consolidatedWorksheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets("CIP Summary")) ' assign the sheet so it can be qualified.
consolidatedWorksheet.Name = "Consolidated" ' no longer working with ActiveSheet

Dim titles As Variant 'Now we use an array to set the cell values. In one hit.
titles = Array("Company", "Location", "Store", "RCT/Voucher", "Vendor", "Vendor Name", "Date", "Reference", "Reference", "Amount", "Period", "JE", "Project", "Expected Open Date", "Comment")
With consolidatedWorksheet.Range("A1:N1")
.Value = titles
.Font.Bold = True
End With

Dim sheetIterator As Long ' always use long these days.
Dim rowIterator As Long, columnIterator As Long
Dim sheetContents As Variant

'Cleanse the data
' using an array to save switching the engine nearly 14,000 * 2 times. Now we only switch a few times.
For sheetIterator = 15 To Worksheets.Count ' 15 is a magic number - will it always be right?
With ThisWorkbook.Sheets(sheetIterator) ' set up the array
sheetContents = .Range(.Cells(5, 1), .Cells(1000, 14))
End With
For columnIterator = 1 To 14
For rowIterator = 5 To 1000
If VarType(sheetContents(rowIterator, columnIterator)) = vbError Or sheetContents(rowIterator, columnIterator) = "" Then
sheetContents(rowIterator, columnIterator) = "N/A"
End If
Next rowIterator
Next columnIterator
' replace the values in case there have been changes
With ThisWorkbook.Sheets(sheetIterator) ' set up the array
.Range(.Cells(5, 1), .Cells(1000, 14)) = sheetContents
End With
Next sheetIterator

''''company
''' *** This code forms the thinking for the repetitive routine.
'''    Dim firstCompany As Range
'''    Dim allData As Range
'''    With ThisWorkbook.Sheets(15) ' magic number
'''        Set firstCompany = .Range("A1:N4").Find("Company", LookAt:=xlPart).Offset(1, 0)
'''        Set allData = .Range(firstCompany, firstCompany.End(xlDown))
'''    End With
'''    With ThisWorkbook.Worksheets("Consolidated")
'''        ' the use of the Cells method will open up to making a generic routine
'''        .Range(.Cells(1, 2), .Cells(1, 2)).Value = allData.Value
'''        ' set the values instead of copying cells. But you could adjust this to copy and paste if you wanted.
'''    End With
'''
'''    Dim pasteTarget As Range
'''    For sheetIterator = 16 To Worksheets.Count
'''        With ThisWorkbook.Sheets(sheetIterator)
'''            Set firstCompany = .Range("A1:N5").Find("Company", LookAt:=xlPart).Offset(1, 0)
'''            Set allData = .Range(firstCompany, firstCompany.End(xlDown))
'''        End With
'''        With ThisWorkbook.Worksheets("Consolidated")
'''            Set pasteTarget = Something.End(xlDown) ' At this point I can't tell which is the active cell and where to paste the data.
'''            pasteTarget.Value = allData.Value
'''        End With
'''    Next sheetIterator

' now that we have identified the repetition and put it into the routine
' all we have to do is call the routine

CopyData "Company", 1
CopyData "location", 2
CopyData "store", 3
CopyData "RCT", 4
CopyData "Vendor", 5
CopyData "Vendor Name", 6
CopyData "date", 7
CopyData "reference", 8
CopyData "amount", 9
CopyData "period", 10
CopyData "JE", 11
CopyData "Project", 12
CopyData "expected", 13
CopyData "comment", 14

Application.ScreenUpdating = True ' turn it back on!
End Sub

Private Sub CopyData(category As String, columnNumber As Long)

Dim firstFind As Range
Dim allData As Range
Dim sheetIterator As Long

With ThisWorkbook.Sheets(15) ' magic number
Set firstFind = .Range("A1:N4").Find(category, LookAt:=xlPart).Offset(1, 0)
Set allData = .Range(firstFind, firstFind.End(xlDown))
End With
With ThisWorkbook.Worksheets("Consolidated")
' the use of the Cells method will open up to making a generic routine
.Range(.Cells(1, columnNumber), .Cells(1, columnNumber)).Value = allData.Value
' set the values instead of copying cells. But you could adjust this to copy and paste if you wanted.
End With

Dim pasteTarget As Range
For sheetIterator = 16 To Worksheets.Count
With ThisWorkbook.Sheets(sheetIterator)
Set firstFind = .Range("A1:N5").Find(category, LookAt:=xlPart).Offset(1, 0)
Set allData = .Range(firstFind, firstFind.End(xlDown))
End With
With ThisWorkbook.Worksheets("Consolidated")
Set pasteTarget = Something.End(xlDown) ' At this point I can't tell which is the active cell and where to paste the data.
pasteTarget.Value = allData.Value
End With
Next sheetIterator

End Sub


Of course, the code is not tested so I apologise in advance for any minor errors or other typos that you may find. Also, in re-working the code I identified an ambiguity in selecting where to paste the data - Something is not declared and will cause a compile error. I am sure you can now work something out that does not involve Select or an ActiveCell!

• Thanks @AJD i ran into some bugs with the code you gave me but i will try my best to fix it to accommodate what i need. it is like a foreign right now but it is a learning curve that will help me. thank you alot ! Apr 26, 2019 at 14:07