Macro takes half hour or more to run

[wilkisa]

I have created this macro and when I step through it, it works perfectly. However, if I just run it, it takes a half hour or more and sometimes doesn't completely finish but just bombs out. There are, in this report, over 16,000 lines but this macro will be used in many different reports and some of those will have even more records. Also, I have added comments to each section of the routine so the next person who has to figure out what this code does will at least have some guidance.

<code>
Sub MoveTradeCodes()
'Macro MoveTradeCodes
Application.ScreenUpdating = False
'Put the column title "Count" in E1
Range("E1").Select
ActiveCell.Value = "Count"

'Enter the formula =COUNTIF($D$2:$D$100000,A2) This formula will count all duplicate occurences and
'put the count in the cell.
Range("E2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R2C4:R100000C4,RC[-4])"

'Autofit cell width for column D. Put cursor back in D2 and copy the contents
Range("E2").Select
Selection.Copy

'RIGHT-ARROW over to cell D2 (Trade) and then CTRL-DownArrow to the bottom of column of Trade data
Range("A2").Select
Selection.End(xlDown).Select

'Turn on USE RELATIVE REFERENCES. Arrow back to the right in Col E and CTRL-SHFT-UpArrow to select all of Col E
ActiveCell.Offset(0, 4).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select

'Paste the formula, copy the range again, and PasteSpecial Values to remove the forulas. Clear the copy indicators
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'If count in any cell in column E is equal to 1, then go UP to next. If greater than one, then copy value in equivalent column A
'and insert cells below the equivalent number of times to equal the count.
'REMEMBER: There is always a count of 1 so if the count is 3, insert only 2 cells
Dim lngRC As Long
For lngRC = Range("E" & Rows.Count).End(xlUp).Row - 1 To 1 Step -1
On Error Resume Next
If Cells(lngRC, 5).Value > 1 Then
Cells(lngRC, 5).Offset(0, 0).Copy
Cells(lngRC, 5).Offset(1, 0).Resize(Cells(lngRC, 5).Value - 1, 1).Insert Shift:=xlDown
Cells(lngRC, 1).Offset(0, 0).Copy
Cells(lngRC, 1).Offset(1, 0).Resize(Cells(lngRC, 5).Value - 1, 1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next lngRC
'Insert blank column A enter column heading "CountContracts". Enter formula in A2: =COUNTIF($A$2:A2,A2)&A2) _
This moves all columns to the right by 1 so column letters will change
Range("A1").Select
Selection.EntireColumn.Insert
ActiveCell.Value = "CountContracts"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R2C2:RC[1],RC[1])&RC[1]"
Range("A2").Select

'Copy the formula in A2 then arrow right on column to B2. Ctrl-DownArrow to bottom of range then _
move back to column using the left arrow and Ctrl-Shft-UpArrow to select all the way back to the formula. _
Paste formula in entire range.
Selection.Copy
Range("B2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste

'Copy the range again in column A and PasteSpecial Values to remove the formulas
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Clear the contents of column F (Col E earlier in the macro); count no longer needed.
Columns("F:F").Select
Selection.ClearContents

'Enter formula in cell F2 to create a column to match data in column A
Range("F1").Select
ActiveCell.Value = "RefContracts"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R2C5:RC[-1],RC[-1])&RC[-1]"
Range("F2").Select

'Copy the formula and move to cell E2. Ctrl-DownArrow to move to bottom of column. Right-Arrow to move back into _
column F. Ctrl-Shft-UpArrow to select entire range then paste formula.
Selection.Copy
Range("E2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
'Copy the range again in column F and PasteSpecial Values to remove the formulas
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Name ranges for Column D (TRADE) and Column F (REF). This make creating the formula easier to manage
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="Trade", RefersToR1C1:="='FCGO Contracts'!R2C4:R100000C4"
ActiveWorkbook.Names("Trade").Comment = ""
Range("F2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="REF", RefersToR1C1:="='FCGO Contracts'!R2C6:R100000C6"
ActiveWorkbook.Names("Ref").Comment = ""
'In cell C2, enter the following formula: =INDEX(TRADE,MATCH(A2,REF,0))
Range("C2").Select
ActiveCell.FormulaR1C1 = "=INDEX(Trade,MATCH(RC[-2],REF,0))"
'Copy the formula then move to column B and Ctrl-DownArrow to move to bottom. Use right arrow to move back into column C _
and Ctrl-Shft-UpArrow to select entire range.
Range("C2").Select
Selection.Copy
Range("B2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste

'Copy/PasteSpecial Values to remove formulas
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Remove columns A & F as they are no longer needed
Columns("F:F").Select
Selection.ClearContents
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
Application.ScreenUpdating = True
End Sub
</code>

Can someone help me tweak this to speed it up?

Thanks,
Shirlene

 

[BrianMH]

Hi,

I'm just at work and waiting for a response from an email so have a moment to reply (but not redo your code).

The first thing that comes to mind is getting rid of all the selecting and work directly with the range objects. You don't need to work with selections at all. See an example below.

Range("E1").Select
ActiveCell.Value = "Count"

can be reduced to

Range("E1").value = "Count"

You can also declare a range object variable then assign a range to that and manipulate it that way. Working with objects is cleaner, more efficient and once you get the usage it is much easier to code.

 

[wilkisa]

Thanks, Brian. I'm very good with Excel formulas but rather weak in VBA, as I'm sure my code clearly shows. I don't understand "declare a range object variable". Can you briefly give me an example such as you did with "count"? I can also tell you that it is slowest when I have to copy/pastespecial values, which I do several times within the code.