In a workbook (Vat Current) I have 5 worksheets, Summary, 1st Quarter Nov-Jan, 2nd Quarter Feb-April, 3rd Quarter May-July and 4th Quarter Aug-Oct. There is one table on each of the worksheets, FirsQ, SecondQ, ThirdQ and FourthQ with a total number of records around 1200.
On the summary sheet I have a list of Suppliers starting at cell AW19 and going down to AW420 (this will grow)
I need to take each supplier, then loop through each of the tables (FirsQ, SecondQ, ThirdQ and FourthQ) and count how many entries there are and write that number in column AX adjacent to the Suppliers name.
I have written some looping code that does work (sometimes) but it can take 15 minutes and looking in Task Manager, Excel is using in excess of 4Gb memory while executing.
If it completes the task, no other code can be run unless I restart Excel.
Sometimes it never completes and I have to End Task.
I know I am looking at around 400 suppliers x around 1200 records = around 480,000 items, but should it take this long? Is there a better more efficient way to do this?
Microsoft Excel for Microsoft 365 MSO (Version 2402 Build 16.0.17328.20068) 64-bit
Posts
28,185
Re: Very s l o w looping
without a file, it will not be possible to test your code and changes to it. A small file of 2-30 rows will normally suffice with (obviously!) any confidential data removed.
If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.
Hi John thanks for your interest.
Attached is a very much thinned out workbook, I have left only data required for the count and I have removed most of the columns on each sheet.
Even with this much reduced workbook, when I clicked the button Excel was using around 4 gig of memory and 40% of my cpu.
BTW - you have lots of blank rows on your monthly list(s).
If your lists grow on the non-summary sheets we can make the above formula more generalized.
One test is worth a thousand opinions. Click the * Add Reputation below to say thanks.
The blank rows are my fault as I removed lots of records but forgot to remove the blanks.
The formula just replaced the list I already have, it didn’t enter the number of entries from all the quarterly sheets.
The list as well as the 4 quarterly sheets will all get larger over time.
a = Range("Summary!AW18").CurrentRegion.Value: Q = UBound(a) Set D = CreateObject("Scripting.Dictionary") For i = 2 To Q: D(a(i, 1)) = 0: Next
For hj = 1 + Sheets("Summary").Index To Worksheets.Count a = Sheets(hj).Range("F4", Sheets(hj).Cells(Rows.Count, "F").End(xlUp)).Value: Q = UBound(a) For i = 1 To Q If a(i, 1) <> "" Then D(a(i, 1)) = D(a(i, 1)) + 1 Next Next
Q = D.Count With Sheets("Summary").Range("aw18:ax18") .Offset(1).Resize(Q).Delete xlShiftUp .Cells(2, 1).Resize(Q) = Application.Transpose(D.keys) .Cells(2, 2).Resize(Q) = Application.Transpose(D.items) .Resize(1 + Q).Sort .Cells(1), 1, Header:=xlYes Application.Goto .Parent.Range("au16"), True End With
D = Empty: a = Empty: MsgBox "End."
End Sub
You are always very welcome if you add reputation by clicking the * (bottom left) of each message that has helped you.
You are a tough one to please. See the attached with no VBA, that has what you wanted on the Summary sheet down at row 20. Vat Current kjg Answer with Counts.xlsm
Hi Guys,
I would like to thank you all for your patients with me and my request for help, it always amazes me how many people are willing to help others.
It also amazes me how many ways there are to achieve the results required, most of which I don’t fully understand.
I woke up this morning with 4 potential solutions, I have tried all 4 and each gives me what I require, but I think I will be using the solution that protonLeah supplied as it is more inline with what I am doing before and after I get the results.
As the Payees list and each quarter was edited to remove individual names, some were overlooked, this is why you found some extra in one place and not in another.
The solution I presented to you is part of the original list (like all alternative solutions).
But since the macro then goes through its Payees lists -sheet by sheet-, it ends up obtaining the new ones (if there are any).
If you had requested an update of Payees, then the original list would not have to be taken into account and it would be enough to see what you have on your 4 sheets.
LinkBack URL
About LinkBacks
Register To Reply
Click the * Add Reputation below to say thanks. 
Originally Posted by kjg
Bookmarks