SumProduct DEFINITELY has its uses, but I try to avoid using Worksheet formulas
in VBA when possible.
I see that you're using Excel2007 (from the .xlsm extension)
Excel2007 has a HUGE bug dealing with CPU priority.
When the window "focus" changes to another window, and the CPU usage remains
high,
Excel automatically reduces the Windows priority to "allow" you to do other
things while it's running.
I think the Programmers at MS think that while Excel Macros are running, we'll
be doing
something IMPORTANT while we wait and we'll need to share the CPU time,
or they simply got tired of the slow card dealing in Solitaire.
I have one application that is over 30,000 lines of code that updates 90,000+
records
from 6 different data sources.
It USED to run (in Office97) in 45 minutes. In Office2007 it was taking 3+
hours!
It LOOKED like the application "hangs", but it's really in "background" and not
"waking up"
when you select it.
Now, you CAN go into Task Manager and change the priority of Excel, but you
have
to do it every
time you open Excel.
What I've done is "borrowed" a macro (from internet searches!) that sets the
Windows Priority and I run it in the Workbook_Open event.
Something else I've discovered.
Updating a cell or Statusbar for every loop is VERY CPU exhausting.
It's like adding a second (or 1/2 second) to every loop!
It works great for testing, but not for daily use!
Usually, what I do is:
#1) turn off display updating: Application.UpdateDisplay = false
#2) only update the Status bar (or cell) every # cycles.
For instance: Let's say I have LOTS of rows (13,000 perhaps?)
You COULD simply update the status every 10, 100, or 1000 rows
by using the MOD function.
MOD divides two numbers and returns the REMAINDER.
100/9 is 11 with 1 left over.
100/10 is 10 with 0 left over.
so, if you took the current row number and divided it by, let's say, 100.
every time the row number reaches an even 100, the remainder from the division:
1300/100 = 13 remainder 0, or 1300 mod 100 = 0
you could update the status:
if (rownum mod 100 = 0) then Application.Statusbar = rownum & " of " & rowcount
But I like to update every 5% of the completed rows.
Since the # of rows changes from one report to the next, I need to Calculate
the
5% mark.
'First: Count the rows of data:
RowCnt = Application.WorksheetFunction.CountA(Sheets("Data").Columns("A:A"))
'Now, 5% is 1/20th of the rows, so:
rMOD = Round(RowCnt / 20, 0)
Set DataRange = Worksheets("Data").Range("A1:A" & RowCnt)
For Each Data In DataRange.Columns(1).Cells
If (Data.Row Mod rMOD = 0) Then
Application.StatusBar = "Processing: " & Round((Data.Row / RowCnt) *
100, 0) & "%: row: " & Data.Row & " of " & RowCnt & " Records"
End If
.
.
.
Next Data
Application.StatusBar = False
Once I did that in your macros, it no longer "hangs"... it still takes a long
time,
so I like the Dictionary solution better.
I've used the Dictionary to do multiple lookups also.
For instance: I load the dictionary using the index, and update the values
with
the array of rows
for that index:
for example, the dictionary is by "originator".
the value is:
dict_orig.item(schreiner) = 100|105|310|416|500
then, when I want to report by originator, I read the dictionary, split the
value into an array
and loop through the array.
let me know if I can be any more help..
Paul
>
>From: Dave Bonallack <davebonall...@hotmail.com>
>To: "excel-macros@googlegroups.com" <excel-macros@googlegroups.com>
>Sent: Thu, September 30, 2010 10:31:57 PM
>Subject: RE: $$Excel-Macros$$ Macro hangs
>
>Hi Paul,
>Thanks for spending time on this. I saw another post of yours about
>using dictionaries which got my attention at the time, but then I got
>distracted
>by something shiny, and the moment was lost. I'll have a look at your reply
>(below) in detail on the weekend.
>But, being a curious lad, I'd like to know why my current macro hangs XL. The
>macro has a "progress report" row counter which updates cell G1 every time a
>row
>is checked, so I know when the macro has actually stopped running. Also, when
>I
>then press Escape, the whole screen sort of fades to white.
>If I could inspire you to share my curiosity, perhaps you could open my
>workbook
>and run it (with the timer section disabled), and let me know if you have any
>ideas on what I've done wrong. But if your macro really does do 13000 lines in
>just over a minute (and I have no reason to doubt you) then I will definitely
>be
>impressed, and dictionaries may even rise above SumProduct (in my eyes).
>Regards - Dave.
>
>> Date: Wed, 29 Sep 2010 05:15:54 -0700
>> From: schreiner_p...@att.net
>> Subject: Re: $$Excel-Macros$$ Macro hangs
>> To: excel-macros@googlegroups.com
>>
>> Dave, keep in mind that Excel can do several HUNDRED comparisons each SECOND.
>>
>> If you're adding an Application.wait for only ONE second EACH LINE for
>> 13,000
>> lines,
>> you're adding 13,000 SECONDS, or 216 minutes, or 3.6 hours of WAIT TIME!
>>
>> so, I suspect that you're not "hanging", but simply waiting a LONG time.
>> and, during the seconds of waiting, the escape characters used to interrupt
>> aren't being received.
>>
>> Now.. personally, I like using excel "dictionaries" to store unique data.
>> I've done some pretty elaborate things.
>> I wrote a script to compare the fields and sum the columns.
>>
>> It runs (on my machine) in 1 minute, 19 seconds...
>>
>> try this (watch for wrapping from email):
>> it also displays a status line in the status bar.
>>
>> Sub DeleteDuplicateDict()
>> Dim RowCnt, R, Datainx, stat, msg
>> Dim Dict_E, Dict_F
>> Dim tstart, tstop, TMin, TSec, TElapsed
>>
>> tstart = Timer
>> Application.ScreenUpdating = False
>> Set Dict_E = CreateObject("Scripting.Dictionary")
>> Set Dict_F = CreateObject("Scripting.Dictionary")
>>
>> stat = Dict_E.RemoveAll
>> stat = Dict_F.RemoveAll
>>
>> ' Count the number of rows in sheet
>> RowCnt = ActiveCell.SpecialCells(xlLastCell).Row
>> 'Starting in the last row, process upwards
>> For R = RowCnt To 2 Step -1
>> If (R Mod 500 = 0) Then Application.StatusBar = "Processing: " & R
>> Datainx = ActiveSheet.Cells(R, "B").Value & ActiveSheet.Cells(R,
>> "C").Value & ActiveSheet.Cells(R, "D").Value
>> If (Datainx & "X" <> "X") Then 'If the data row is not blank
>> If (Not Dict_E.exists(Datainx)) Then
>> 'new data, add new record to dictionaries
>> Dict_E.Add Datainx, ActiveSheet.Cells(R, "E").Value
>> Dict_F.Add Datainx, ActiveSheet.Cells(R, "F").Value
>> Else
>> 'Existing records, update dictionaries
>> Dict_E.Item(Datainx) = Dict_E.Item(Datainx) +
>> ActiveSheet.Cells(R, "E").Value
>> Dict_F.Item(Datainx) = Dict_F.Item(Datainx) +
>> ActiveSheet.Cells(R, "F").Value
>> Rows(R).Delete Shift:=xlUp
>> End If
>> End If
>> Next R
>> ' Count rows remaining
>> RowCnt = Application.WorksheetFunction.CountA(Range("A:A"))
>> For R = 2 To RowCnt
>> If (R Mod 500 = 0) Then Application.StatusBar = "Updating: " & R & "
>> of
>>
>> " & RowCnt
>> Datainx = ActiveSheet.Cells(R, "B").Value & ActiveSheet.Cells(R,
>> "C").Value & ActiveSheet.Cells(R, "D").Value
>> 'update rows with Dictionary values
>> If (Dict_E.exists(Datainx)) Then
>> ActiveSheet.Cells(R, "E").Value = Dict_E.Item(Datainx)
>> ActiveSheet.Cells(R, "F").Value = Dict_F.Item(Datainx)
>> Else
>> Cells(R, "A").Select
>> MsgBox "Missing data for row: " & R
>> End If
>> Next R
>>
>> 'display processing time
>> tstop = Timer
>> TMin = 0
>> TElapsed = tstop - tstart
>> TMin = TElapsed \ 60
>> TSec = TElapsed Mod 60
>> msg = msg & Chr(13) & Chr(13)
>> If (TMin > 0) Then msg = msg & TMin & " mins "
>> msg = msg & TSec & " sec"
>> MsgBox msg
>> Application.StatusBar = False
>> Application.ScreenUpdating = True
>> End Sub
>>
>>
>> Paul
>> >
>> >From: Dave Bonallack <davebonall...@hotmail.com>
>> >To: "excel-macros@googlegroups.com" <excel-macros@googlegroups.com>
>> >Sent: Wed, September 29, 2010 5:14:06 AM
>> >Subject: $$Excel-Macros$$ Macro hangs
>> >
>> >Hi group,
>> >I'm hoping someone can help me with the attached workbook.
>> >I've written a macro that makes XL freeze.
>> >The need is to check the data for duplicates based on Columns B, C & D. If
>> >duplicates are found, their totals in Columns E & F are to be sumed, then
>> >the
>
>> >duplicate row deleted.
>> >I concatonate Cells B2, C2 & D2, then compare that with a concatonation of
>>cells
>>
>> >
>> >B3, C3 & D3, then B4, C4 & D4, and so on to the end of the data, dealing
>> >with
>
>> >duplicates as they come up. Then I start again with row 3, and so on until
>> >all
>>
>> >the data is checked. The macro takes a long time to run, so I report
>> >progress
>>in
>>
>> >
>> >Cells G1 and H1.
>> >Whenever I run this macro, it never gets past about line 10 before XL
>> >freezes,
>>
>> >and I have to use the Windows Task Manager to close it.
>> >There may be a better way of doing this, but my question is, why does it
>> >cause
>>
>> >XL to freeze? It seems a simple enough piece of code.
>> >You will notice 5 lines of code remmed out. When active, this inserts a 1
>>second
>>
>> >
>> >(approx) delay after each row has been checked, and the code runs without
>> >freezing, but of course, with 13000 rows, adds about 3.6 hours to the run
>> >time
>>
>> >of the macro.
>> >This happens with XL2003 and XL2007, and on another computer as well.
>> >Anyone have any ideas?
>> >Regards - Dave.
>> >--
>>>----------------------------------------------------------------------------------
>>-
>> >
>> >
>> >Some important links for excel users:
>> >1. Follow us on TWITTER for tips tricks and links :
>> >http://twitter.com/exceldailytip
>> >2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
>> >3. Excel tutorials at http://www.excel-macros.blogspot.com
>> >4. Learn VBA Macros at http://www.quickvba.blogspot.com
>> >5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>> >
>> >To post to this group, send email to excel-macros@googlegroups.com
>> >
>> ><><><><><><><><><><><><><><><><><><><><><><>
>> >Like our page on facebook , Just follow below link
>> >http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
>> >
>>
>> --
>>----------------------------------------------------------------------------------
>>-
>> Some important links for excel users:
>> 1. Follow us on TWITTER for tips tricks and links :
>>http://twitter.com/exceldailytip
>> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
>> 3. Excel tutorials at http://www.excel-macros.blogspot.com
>> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
>> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>>
>> To post to this group, send email to excel-macros@googlegroups.com
>>
>> <><><><><><><><><><><><><><><><><><><><><><>
>> Like our page on facebook , Just follow below link
>> http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
>--
>----------------------------------------------------------------------------------
>
>Some important links for excel users:
>1. Follow us on TWITTER for tips tricks and links :
>http://twitter.com/exceldailytip
>2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
>3. Excel tutorials at http://www.excel-macros.blogspot.com
>4. Learn VBA Macros at http://www.quickvba.blogspot.com
>5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
>To post to this group, send email to excel-macros@googlegroups.com
>
><><><><><><><><><><><><><><><><><><><><><><>
>Like our page on facebook , Just follow below link
>http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
