I have a program running in a .xlsm 2007 spreadsheet that formats data and
moves the data from one worksheet to another (in the same workbook). The
problem is that it runs painfully slow. I tested it with 2000 rows @ ~8
minutes, 3000 rows @ ~15 minutes and 4000 rows @ ~28 minutes. When the
program starts my CPU usage spikes up to 52%, 51% of which is EXCEL.EXE.
Also, while it's running I have "Calculating(Processor(2)): XX%" in my status
bar. You can see the data being added one block at a time (one iteration of
the code) as it cycles through the Calculating process. I just don't
understand what's causing it to have such latency. Is there a way to make
the code more efficient so that it runs faster? What's causing the
Calculating(Processor(2)): % to pop up? I have other macros running in this
same workbook and they run fine.

My code:

'This code formats the data downloaded from Catalyst (in the Catalyst Dump
'tab) and puts in the Tally Sheet to be reviewed
Sub TallySheetRepDump()

Dim LastRow As Integer
Dim StartRow As Integer
Dim TSPasteRow As Integer 'Tally Sheet
Dim TSStartRow As Integer 'Tally Sheet
Dim RowCount As Integer
Dim EndRow As Integer
Dim CheckRow As Integer
Dim AddRow As Integer
Dim counter As Integer
Dim PCounter As Integer 'Progress Counter
Dim PctDone As Single 'Percent Done

With Sheets("Tally Sheet")
.Shapes("BigOrangeButton").Cut
End With

With Sheets("SortedRepData")
'The following line of code calculates the number of rows of data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'Sort by UID (column A) then by Transaction Amount (column F)
.Rows("1:" & LastRow).Sort _
Key1:=.Range("R1"), _
Order1:=xlAscending, _
Key2:=.Range("A1"), _
Order2:=xlAscending, _
Key3:=.Range("F1"), _
Order3:=xlAscending, _
Header:=xlNo

StartRow = 1
TSPasteRow = 6
RowCount = 0
'Outer loop for entire worksheet.
Do
RowCount = RowCount + 1
'Check to see if RowCount is equal to the next row. If not that
'means the name has changed and we want to capture the info for
'the current rep
If .Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then
'If name changes make sure the rep has 3 or more transactions
EndRow = StartRow + 2
CheckRow = StartRow
AddRow = 2
'If rep has at least 3 transactions then copy the first 3 and
'move them to the Tally Sheet
If .Range("A" & StartRow) = .Range("A" & EndRow) Then
.Range("A" & StartRow & ":F" & EndRow).Copy _
Destination:=Sheets("Tally Sheet").Range("A" & TSPasteRow)
.Range("G" & StartRow & ":Q" & EndRow).Copy _
Destination:=Sheets("Tally Sheet").Range("N" & TSPasteRow)
TSPasteRow = TSPasteRow + 8
StartRow = RowCount + 1
'If rep doesn't have at least 3 transactions then determine how
many
'transactions they do have and add the appropriate number of rows
Else
For counter = CheckRow To EndRow
If .Range("A" & CheckRow) = .Range("A" & (CheckRow + 1))
Then
AddRow = AddRow - 1
CheckRow = CheckRow + 1
Else
.Rows(CheckRow + 1).Resize(AddRow).Insert
(xlShiftDown)
RowCount = RowCount + AddRow
.Range("A" & StartRow & ":F" & EndRow).Copy _
Destination:=Sheets("Tally Sheet").Range("A" &
TSPasteRow)
.Range("G" & StartRow & ":Q" & EndRow).Copy _
Destination:=Sheets("Tally Sheet").Range("N" &
TSPasteRow)
TSPasteRow = TSPasteRow + 8
LastRow = LastRow + AddRow
StartRow = RowCount + AddRow
Exit For
End If
Next counter
End If
End If
PctDone = (RowCount / LastRow)
Call UpdateSevenRProgress(PctDone)
Loop Until RowCount = LastRow
End With
With Sheets("Tally Sheet")
'This code inputs the formulas to map over the info from the $7 Report
'for each rep being reviewed. &Y&2 refers to cell Y2 on the tally sheet
'that contains the following formula:
':=IF(ISNA(TEXT(LOOKUP(A1,X!D1:D12,X!E1:E12),)&" 09 $7
Report.xls"),"",TEXT(LOOKUP(A1,X!D1:D12,X!E1:E12), )&" 09 $7 Report.xls")
'This basically says that if any info from the $7 report causes a NA
error
'then do nothing else use the formula to locate the pertinent info in
the $7 Report,
'and mirror the info in the tally sheet.
'The $7 Report must be saved in the following format to work: Feb 09
$7 Report
TSPasteRow = TSPasteRow - 8
TSStartRow = 6
For RowCount = TSStartRow To TSPasteRow Step 8
If TSStartRow <= TSPasteRow Then
.Range("Z" & TSStartRow).Formula = _
"=IF(ISNA(VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),11,FALSE)),""""," _
& "VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),11,FALSE))"
.Range("AA" & TSStartRow).Formula = _
"=IF(ISNA(VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),6,FALSE)),""""," _
& "VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),6,FALSE))"
.Range("AB" & TSStartRow).Formula = _
"=IF(ISNA(INDIRECT(""'[""&$Y$2&""]By_Function'!$B$6"")),""""," & _
"INDIRECT(""'[""&$Y$2&""]By_Function'!$B$6""))"
.Range("AC" & TSStartRow).Formula = _
"=IF(ISNA(VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),7,FALSE)),""""," _
& "VLOOKUP($A" & TSStartRow _
& ",INDIRECT(""'[""&$Y$2&""]By_Rep_by_Filter'" _
& "!$F$1:$P$20000""),7,FALSE))"
.Range("Z" & TSStartRow & ":AC" & (TSStartRow + 2)).FillDown
TSStartRow = TSStartRow + 8
End If
'The next 2 lines of code show a Progess Indicator
PctDone = (TSStartRow - 8) / TSPasteRow
Call UpdateSevenRProgress(PctDone)
Next RowCount
Unload SevenRProgressIndicatorF
End With
End Sub