How to fix macro timing issue

Question

i wrote a macro that is take 20 mins+ 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 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.

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

Any help would be nice. Since i am new to this it has taken me a little longer then expected to create this code. Thank You in advanced !

You can start [avoiding activate and select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — cybernetic.nomad, Apr 25 '19 at 18:24
This is probably more appropriate for [posting over at code review](https://codereview.stackexchange.com). — SmrtGrunt, Apr 25 '19 at 18:30
I also think that its helpful if the OP wrote a brief summary of the intention of the code. I could spend 5-10 minutes digesting the code and discovering this but the inclusion of a brief overview really helps one "on-ramp" into the purpose of the code. — Jeff Mergler, Apr 25 '19 at 20:58

score 0 · Answer 1 · answered Apr 25 '19 at 18:51

Stop usign Activate and select
Use variables
Replace your earlier code for this for example.

Public sub

Dim i As Integer
Dim r As Long, c As Long
Dim contMax As Long
Dim newSheet As Worksheet


Application.ScreenUpdating = False

  Set newSheet = Sheets.Add


   With newSheet
        .Name = "Consolidated"
        .Range("A1:N1").Value2 = Array("Company", _
                                "Location" _
                                , "Store" _
                                , "RCT/Voucher", _
                                , "Vendor", _
                                "Vendor Name" _
                                , "Date" _
                                , "Reference" _
                                , "Amount" _
                                , "Period" _
                                , "JE" _
                                , "Project" _
                                , "Expected Open Date" _
                                , "Comment")
     .Range("A1:N1").Font.Bold = True
    End With

(In the Array, I think you've doubled up on commas in some places.) — BruceWayne, Apr 25 '19 at 18:57

How to fix macro timing issue

1 Answers1