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

Reply via email to