Calculating(Processors(2)): %

  • Follow


I am running the code below in a .xlsm '07 spreadsheet.  The problem I'm 
having is the code runs painfully slow and I can't figure out why.  As soon 
as it starts my CPU usage spikes up to 52%, 51% of which is EXCEL.EXE.  I 
also get "Calculating(Processors(2)):  %" in my status bar constantly 
calculating "something" and showing me percentages.  I tested this code using 
1000 rows of data and it took ~8 mins, 2000 rows took ~15 mins, and 4000 rows 
took ~28 mins.  Each row of data has information in columns A-Q.  What is 
causing this latency?  All the code does is sort and move data from one 
worksheet to another worksheet in the same workbook.

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


0
Reply Utf 2/2/2010 9:48:01 PM

While waiting for an expert response, I'll entertain you with my random 
babbling :)

1. It appears that in the latter part of your macro you are adding formulas, 
but I don't see you setting the application.calculation to false at the 
beginning of your procedure (and reseting it to automatic, or whatever your 
preference is at the end). Using application.calculation = false will keep 
those formulas from continuously recalculating as you change the sheet, and 
that should save you some processing.

2. I recall numerous complaints about the speed of worksheet changes like 
row insertion. Consider an alternate approach of loading the data into 
memory, and manipulating everything in memory, then write it back to the 
sheet just once (eliminate all the within-loop changes). I'd bet money that 
this would have a tremendous impact on your processing speed.

3. As an alternative to #2, I suppose you could just copy the data to a new 
sheet, and skip down "x" rows instead of inserting rows. That should still be 
faster than inserting rows, although it does leave you with an extra sheet at 
the end of your processing...

4. That is one monster formula. I didn't try to dissect it, but looking at 
all of those indirects, I have to wonder if there isn't a way to shorten the 
formula, and thereby also decrease processing time. If you were willing to 
loop instead of using autofill, you could pass the range references from your 
variables instead of using indirects. Some of the other pieces might also be 
shrinkable (I'm thinking the vlookups) but like I said, I didn't dissect it. 
Consider this option- do these values need to change because the source data 
ranges will be changing, or is this all just to pull a summary number? If the 
source data isn't expected to change, can you just calculate the value that 
the formula would return (in VBA), and just paste the final value into the 
destination cell(s)? I guess to see if this really matters, but a time stamp 
just before and just after that formula line, and see how long it takes to 
process just that one step. If it is relatively short, then it isn't worth 
worrying about.
add: debug.print format(now(),"HH:MM:SS") on either end of that formula 
line, then look in the debug window to see how much time elapsed between the 
two result lines.

Best,
Keith

"Bishop" wrote:

> I am running the code below in a .xlsm '07 spreadsheet.  The problem I'm 
> having is the code runs painfully slow and I can't figure out why.  As soon 
> as it starts my CPU usage spikes up to 52%, 51% of which is EXCEL.EXE.  I 
> also get "Calculating(Processors(2)):  %" in my status bar constantly 
> calculating "something" and showing me percentages.  I tested this code using 
> 1000 rows of data and it took ~8 mins, 2000 rows took ~15 mins, and 4000 rows 
> took ~28 mins.  Each row of data has information in columns A-Q.  What is 
> causing this latency?  All the code does is sort and move data from one 
> worksheet to another worksheet in the same workbook.
> 
> 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
> 
> 
0
Reply Utf 2/2/2010 11:43:01 PM


1 Replies
1387 Views

(page loaded in 0.059 seconds)

Similiar Articles:
















7/21/2012 7:25:14 PM


Reply: