Consolidating several Excel sheets into one

Question

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
    Sheets.Add

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

Answer 1

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!