PDA

View Full Version : VBA - Search For Value Across Multiple Worksheets



Steve Belsch
05-11-2020, 12:37 PM
Hi VBA Experts,

I wrote code that I except it to find a value that exists in multiple tabs and return a specific cell where that match exists. Here is the code, and I have attached a small version of the document with the code. In this example I expected to have the program return the worksheet name and the PO's found in each of those tabs. However, It is only picking up the first tab, but yet there is data in both tabs for the instance of PO 235204.

Sub Multiple_Sheet_Count_Match()


Application.ScreenUpdating = True


totalsheets = Worksheets.Count
POs = Worksheets("End Result").Cells(2, 4).Value
For i = 1 To totalsheets
If Worksheets(i).Name <> "End Result" Then
lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lastrow
If Worksheets(i).Cells(j, i).Value = POs Then
Worksheets("End Result").Activate

lastrow = Worksheets("End Result").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("End Result").Cells(lastrow + 1, 1).Value = Worksheets(i).Name
Worksheets("End Result").Cells(lastrow + 1, 2).Value = Worksheets(i).Cells(j, 1).Value
End If

Next
End If
Next


Application.ScreenUpdating = False

End Sub



Any ideas would be greatly appreciated.

Thanks.
Steve

paulked
05-11-2020, 01:40 PM
Change the i for a 1 in:



If Worksheets(i).Cells(j, 1).Value = POs Then

Steve Belsch
05-11-2020, 07:20 PM
paulked,

Thank you! One more idea would be appreciated. What if I want to look at all of the purchase orders in the first tab, with some sort of loop formula or another if then else, and look in the second tab to see where there are matches. Then return that list of matches to another tab. Could it be a set of code that is built around this code? The ultimate goal is to find all matches, and it my larger workbook I will need to look at 111 worksheets to find matches with that first tab to another worksheet. I only care about matches with the PO's, column A.

Any ideas?

Thank you for your help.

Steve

paulked
05-11-2020, 09:14 PM
Sure. I would use two arrays and a dictionary. An example for the two sheets supplied with your workbook would be:



Sub test()
Dim arS1, arS2, lr As Long, i As Long, j As Long
Dim dic As New Scripting.Dictionary, kys()
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet1.Range("A1:A" & lr)
lr = Sheet2.Cells(Rows.Count, 1).End(3).Row
arS2 = Sheet2.Range("A1:A" & lr)
For i = 2 To UBound(arS1)
For j = 3 To UBound(arS2)
If arS1(i, 1) = arS2(j, 1) Then
With dic
If Not .Exists(arS2(j, 1)) Then .Add arS2(j, 1), Nothing
End With
End If
Next
Next
kys = dic.Keys
Sheet4.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End Sub

Steve Belsch
05-12-2020, 07:08 AM
Paulked,

Thank you. I am not familiar with using a dictionary in VBA. Is there a way to do a loop on the suggested 6732-Test Macro file code that you did? Something that goes through a repeats for every workbook to look for matches? And if so, is there a way to "Rows(1).EntireRow.Delete" for those matching items that have been found in the "PO Accrual Data" worksheet? Instead of listing the matches, it would delete the entire row in the PO Accrual Data tab.

Thanks.
Steve

paulked
05-12-2020, 09:19 AM
Add another loop to go through worksheets and instead of using the dictionary, delete the items within the loop.

Sorry, but I'm pressed for time to give you an example. If you post your workbook I'll have a look later/tomorrow morning.

Steve Belsch
05-12-2020, 09:50 AM
paulked,

Ok I will try that. Quick question on the macro you suggested gets hung up on this line of code: Windows("67340-2020-2021 Workbook V. 2.xlsm").Activate

It is looking or another file. But when I click on your macro button it runs fine. Any idea why?

Thanks.
Steve

Steve Belsch
05-12-2020, 11:21 AM
Paulked,

Is this what you suggested? I tried and it stops working at "totalsheets = Worksheets.Count".

I just nested your formula inside the If Then

totalsheets = Worksheets.Count

Thanks for the help.

Steve

Steve Belsch
05-12-2020, 11:39 AM
Here is the code, which isn't working.

Sub Find_PO_Matches3()


Dim lr
lr = Worksheets("End Result").Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = True


totalsheets = Worksheets.Count
POs = Worksheets("End Result").Cells(2, 4).Value
For i = 1 To totalsheets
If Worksheets(i).Name <> "End Result" Then
LastRow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To LastRow
If Worksheets(i).Cells(j, 1).Value = POs Then

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Sheets("Test Data Set").Select
Range("C73,A3").Select
Range("A3").Activate
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-310
Windows("67340-2020-2021 Workbook V. 2.xlsm").Activate
Windows("67342-Test Macro - Delete Used POs.xlsm").Activate

End If

Next
End If
Next


End Sub

paulked
05-12-2020, 01:08 PM
What code is that? (btw, you should enclose any code in Code Tags (# on the editor menu)

If you don't want to post your workbook then I'll need to know where the data is on each of the 111 sheets.

Steve Belsch
05-12-2020, 03:50 PM
paulked,

Thanks for the response. I truly appreciate your expertise!

I am not sure what you mean by # on the editor menu. I will go figure that out.

I don't want to post that workbook because it is just too big. So, the second attachment has a few tabs with data to help me figure out and test the best way to do this:

What I am looking to do is compare each column A in each worksheet to column A in the "PO Accrual Data" worksheet. If there is a match then I would like to delete that row in the "PO Accrual Data" worksheet.

Thanks again for any help.

Steve

paulked
05-12-2020, 05:04 PM
26647

Backup before using it!!!!
Here's the code:



Sub test1()
Dim arS1, arS2, lr As Long, i As Long, j As Long, x As Long, sh As Worksheet
Dim dic As New Scripting.Dictionary, kys()
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet1.Range("A1:A" & lr)
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "PO Accrual Data" Then
lr = sh.Cells(Rows.Count, 1).End(3).Row
If lr < 3 Then GoTo Nxt
For i = 2 To UBound(arS1)
For j = lr To 3 Step -1
If arS1(i, 1) = sh.Cells(j, 1) Then
sh.Range("A" & j).EntireRow.Delete
End If
Next
Next
End If
Nxt:
Next
End Sub

Steve Belsch
05-12-2020, 09:25 PM
paulked,

You have been so helpful!! Now I understand what you mean by the # sign. Thank you so I can continue to participate on this forum as I am new.

As far as the macro. My intention was delete the row in the ""PO Accrual Data" worksheet if there was a match in the other worksheets column A. Not the other tabs. What would I code to make that happen? So for example if I find a match with column A in "PO Accrual Data" worksheet with any other worksheet, how would I delete that row in the "PO Accrual Data" worksheet? I need all other tabs to remain as is.

Your skills are amazing.

Thanks.
Steve

Steve Belsch
05-12-2020, 09:30 PM
And keep all of the data on all the other worksheets not named "PO Accrual Data".

Steve Belsch
05-12-2020, 09:35 PM
This code is deleting all of the other tabs of rows data instead of all the other tabs. I was trying to delete the "PO Accrual Data" row when it found an instance of a match in another tab. How do I do that code?

You have been an incredible help!

Steve

paulked
05-13-2020, 05:39 AM
Sorry, I misread your request.


Sub DelPOs()
Dim arS1 As Variant, arS2 As Variant, lr As Long, i As Long, j As Long, sh As Worksheet
Dim dic As New Scripting.Dictionary, kys() As Variant, ky As Variant, tm#
tm = Timer
'Get list of PO's to search for
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet1.Range("A1:A" & lr)
'Loop through sheets
For Each sh In ThisWorkbook.Worksheets
'Don't include PO Accrual Data
If sh.Name <> "PO Accrual Data" Then
'Get list of PO's on current sheet
lr = sh.Cells(Rows.Count, 1).End(3).Row
If lr < 3 Then lr = 3 'There are blank sheets!
arS2 = sh.Range("A1:A" & lr)
'Loop through search PO's
For i = 2 To UBound(arS1)
'Loop through sheet PO's
For j = 3 To UBound(arS2)
'If there is a PO match, add it to the dictionary if not already in there
If arS1(i, 1) = arS2(j, 1) Then
If Not dic.Exists(arS2(j, 1)) Then dic.Add arS2(j, 1), Nothing
End If
Next
Next
End If
Next
'Loop through list to delete
For i = UBound(arS1) To 2 Step -1
'Loop through dictionary items
For Each ky In dic.Keys
'If there is a match. delete the PO row
If Sheet1.Cells(i, 1) = ky Then Sheet1.Rows(i).Delete shift:=xlUp
Next
Next
'Show deleted PO's
kys = dic.Keys
If dic.Count <> 0 Then 'Can't print nothing!
Sheet4.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End If
Sheet4.Range("E" & dic.Count + 6) = Timer - tm & " seconds to complete."
End Sub

Steve Belsch
05-13-2020, 08:22 AM
Paulked,

This is awesome! I have learned a lot from you. One last question. Where can I see the dictionary or is this an SQL running in the back ground?

Thank you.
Steve

paulked
05-13-2020, 08:35 AM
Glad to be of help :thumb

The dictionary is printed to Sheet4 E5 down. To view it 'live' you have to be in break mode and look at the Locals window (or put it in the Watch window)

Steve Belsch
05-13-2020, 11:23 AM
Paulked,

When I click on View and then watch window nothing appears. I don't see the window on the bottom of the VBA screen. Any idea how to fix this?

Any ideas on how to fix this? I had the same issue with the Immediate Window.

Thanks,
Steve

paulked
05-13-2020, 12:13 PM
Have you googled it?

Steve Belsch
05-13-2020, 12:44 PM
Yes I did google it. Didn't find a reason why. Maybe it is my excel version. Not sure. I will call my IT.

Steve Belsch
05-13-2020, 12:47 PM
One more question. If there are blank cells in column A will this code stop and not continue to check for a match? The reason I ask is because I set up a macro that creates subtotals of every tab and then it creates 5 blank rows after every subtotal.

Thanks.
Steve

paulked
05-13-2020, 01:01 PM
You'll have to try it, it may delete the rows that have a blank in column A.

Steve Belsch
05-13-2020, 02:33 PM
I am trying to skip multiple pages before I start the code and it won't let me do it. Here is what I am trying to do. But it turns red and highlights the first And_ when I try to move on. Why is that? I have used the And_ in multiple Macros. No idea why it is not working?

If sh.Name <> "PO Accrual Data" And_
sh.name <> "Tab Name List" And_
sh.name <> "Inpute Date" Then


Then

paulked
05-13-2020, 02:48 PM
Leave a space between the And and underscore: And _

Steve Belsch
05-13-2020, 03:22 PM
I just tried that and it didn't work. Strange. I have attached a slimmed down version of my document. Let me know what I am doing wrong. I just need to skip the first 13 tabs

Thank you.
Steve

paulked
05-13-2020, 03:36 PM
Which routine?

Steve Belsch
05-13-2020, 03:55 PM
Paulked,

I have attached a file. I just need to skip the first 13 tabs before I run the code and it is not working. Even if I do the space And _ after the and. Any ideas why?

Thanks.
Steve

paulked
05-13-2020, 04:04 PM
I was asking in which routine (Sub, Macro or whatever you call it) are you having trouble with :doh: I don't want to go through the whole lot checking!

Steve Belsch
05-13-2020, 04:39 PM
The routine that you built for me. Titled Macro1. The part where it codes to skip the <>”PO Data”. I can’t get it to skip more tabs.

paulked
05-13-2020, 04:53 PM
My routine is not in that workbook!

The only routine in the workbook you attached with reference to PO is the RunMacroAcrossAllTabs, and in that you have done the line split correctly!!!!



If xSh.Name <> "Instructions" And _
xSh.Name <> "Accrual & PO Data" And _
xSh.Name <> "Tab Name List" And _
xSh.Name <> "Subtotal Macro Button" And _
xSh.Name <> "Input Date" And _
xSh.Name <> "Summary FY19 F1" And _
xSh.Name <> "EP Local" And _
xSh.Name <> "Driver Definitions" And _
xSh.Name <> "EP Global" Then
xSh.Select 'Run Subtotal Loop on all tabs except these

paulked
05-13-2020, 04:54 PM
Can you now see the importance of attaching a workbook when requested?

Steve Belsch
05-13-2020, 05:16 PM
My apologies. I meant to attach your code. I was so busy removing formulas and tabs to reduce the size of the document to an acceptable size that I forgot to include the awesome code you created.

I am wondering what I did wrong. Because I tried to replicate that code. Maybe I didn’t do it in the correct placement of the code? It wouldn’t let me do it. Maybe it was not included in the if and then loop the correct way.

I apologize again. I am up against a deadline and I have adequate VBA skills, but nothing at your level. And to that I am great full.

so what do you think I am not doing to make this work? Thoughts?

thanks,
steve

paulked
05-13-2020, 05:24 PM
I can see exactly what you are not doing... following instructions! How can I sort it if you don't post it?

Steve Belsch
05-13-2020, 05:35 PM
Paulked,

I have attached the document with your code. If you could please take a look and let me know what i am doing wrong with the And _ for the 1st 13 tabs. I can't make it work for some reason. Your Macro that you built for me is Macro 1.

Thank you!
Steve

paulked
05-13-2020, 06:04 PM
Are you winding me up on purpose? Where is the code you tried to add? All you've given me is exactly what I gave you... am I supposed to guess which 13 sheets you want to miss?

Steve Belsch
05-13-2020, 07:54 PM
paulked,

I am sorry. No I am not trying to wind you up. I updated the Macro with what I was intending to get to work.

This is what is not working. It is in Macro 1 module. It looks correct to me. But it is still red and won't accept the code for some reason.


For Each sh In ThisWorkbook.Worksheets 'Don't include PO Accrual Data
If

Sh.Name <> "Instructions" And _
Sh.Name <> "Accrual & PO Data" And _
Sh.Name <> "Tab Name List" And _
Sh.Name <> "Subtotal Macro Button" And _
Sh.Name <> "Input Date" And _
Sh.Name <> "Summary FY19 F1(5)" And _
Sh.Name <> "Summary FY19 F1(4)" And _
Sh.Name <> "Summary FY19 F1(3)" And _
Sh.Name <> "Summary FY19 F1(2)" And _
Sh.Name <> "Summary FY19 F1" And _
Sh.Name <> "EP Local" And _
Sh.Name <> "Driver Definitions" And _
Sh.Name <> "EP Global" Then

Paul_Hossler
05-13-2020, 08:08 PM
Keep the "If" on the same line as it's checking



If sh.Name <> "Instructions" And _
sh.Name <> "Accrual & PO Data" And _
sh.Name <> "Tab Name List" And _
sh.Name <> "Subtotal Macro Button" And _
sh.Name <> "Input Date" And _
sh.Name <> "Summary FY19 F1(5)" And _
sh.Name <> "Summary FY19 F1(4)" And _
sh.Name <> "Summary FY19 F1(3)" And _
sh.Name <> "Summary FY19 F1(2)" And _
sh.Name <> "Summary FY19 F1" And _
sh.Name <> "EP Local" And _
sh.Name <> "Driver Definitions" And _
sh.Name <> "EP Global" Then

paulked
05-13-2020, 08:13 PM
You can't have line spaces after If!!!



For Each sh In ThisWorkbook.Worksheets 'Don't include PO Accrual Data
If Sh.Name <> "Instructions" And _
Sh.Name <> "Accrual & PO Data" And _
Sh.Name <> "Tab Name List" And _
Sh.Name <> "Subtotal Macro Button" And _
Sh.Name <> "Input Date" And _
Sh.Name <> "Summary FY19 F1(5)" And _
Sh.Name <> "Summary FY19 F1(4)" And _
Sh.Name <> "Summary FY19 F1(3)" And _
Sh.Name <> "Summary FY19 F1(2)" And _
Sh.Name <> "Summary FY19 F1" And _
Sh.Name <> "EP Local" And _
Sh.Name <> "Driver Definitions" And _
Sh.Name <> "EP Global" Then


It compiled but I haven't tested it because the sheet numbers have changed, that code refers to Sheet2 which doesn't exist in this workbook.

Steve Belsch
05-13-2020, 09:08 PM
That worked! No more red. But now I am getting this error message, see attached screen shot.

paulked
05-13-2020, 09:19 PM
Back to the posting the workbook issue! You need to set the reference to the Microsoft Scripting Runtime.

Steve Belsch
05-13-2020, 09:23 PM
Darn. I am not sure what that means?

Steve Belsch
05-13-2020, 09:37 PM
ok. I found that setting. Now I get this. See the attachment.

Steve Belsch
05-13-2020, 10:09 PM
The Data I want to search / reference is in column A of the "Accrual & PO Data" worksheet. So I tried to change your code to Sheet 2. The highlighted yellow in the thumbnail.

That did not work. What am I doing wrong?

Thanks a ton for your expertise! I think that you have me so close to solving my need.

Steve

paulked
05-14-2020, 03:24 AM
It compiled but I haven't tested it because the sheet numbers have changed, that code refers to Sheet2 which doesn't exist in this workbook.

From post #39

Then on the next line you've changed that to Sheet1!!

They need to be changed to either the correct sheet number for the PO sheet OR changed to:



lr = Sheets("Accrual & PO Data").Cells...


etc

paulked
05-14-2020, 03:34 AM
In the last workbook you sent me, the sheet was Sheet153

IF they are the first 13 Sheets in the workbook then you can use



lr = Sheet153.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet153.Range("A1:A" & lr)
'Loop through sheets
For Each sh In ThisWorkbook.Worksheets
'Don't include 1st 13 sheets
If sh.Index > 13 Then
'Get list of PO's on current sheet

Steve Belsch
05-14-2020, 02:33 PM
Paulked,

OK. I will try this tonight. My intention was to skip the first 13 worksheets and not run your code on those. But, the "PO Accrual" worksheet is still needed as the reference to compare all the other worksheets against the PO # column A and then delete out of that worksheet any matches.

I am not sure what you mean about sheet 153? That was the last worksheet in that big file. I need to look at all worksheets (except the first 13) and then compare them to column A in the "PO Accrual" tab.

Will your additional code above accomplish this?

Thanks again for all your help.
Steve

paulked
05-14-2020, 03:09 PM
Sheets can be addressed by either their sheet name (tab name) or their code name.

I normally address them by their code name as the sheet name can easily be changed by the user (as you did with "PO Accrual Data" in post #24 to "Accrual & PO Data" in post #28).

The code name is the name in the Project Explorer before the brackets, the sheet name is the name you see in brackets in the VBE or on the tab of the sheet in Excel:

26679

The Sheet153 code in post #46 can be replaced by either the code name for the PO Accrual sheet or Sheets("Accrual & PO Data") if it is still named that.

IF the first 13 tabs in the workbook are the ones you want to skip, then the code in #46 If sh.Index > 13 Then can be used, otherwise you need to list the sheets you want to skip.

Paul_Hossler
05-14-2020, 06:04 PM
IF the first 13 tabs in the workbook are the ones you want to skip, then the code in #46 If sh.Index > 13 Then can be used, otherwise you need to list the sheets you want to skip.

Since you can't trust users to leave things alone, I'd suggest giving the sheets a meaningful Code Name and using that to determine which sheets to skip

26683

paulked
05-15-2020, 01:05 AM
Thanks Paul, good suggestion, but I doubt that will happen :banghead: I'm almost through this wall though :devil2:

Steve Belsch
05-19-2020, 07:40 AM
Paulked,

I have attached the document with the VBA code. I believe I have included all of your suggestions and VBA code. It is now getting hung up on "Dim dic As New Scripting.Dictionary, kys() As Variant, ky As Variant, tm#".

Why would it get hung up on a Dim?

Thanks.
Steve


Sub DelPOs() Dim arS1 As Variant, arS2 As Variant, lr As Long, i As Long, j As Long, sh As Worksheet
Dim dic As New Scripting.Dictionary, kys() As Variant, ky As Variant, tm#
tm = Timer
'Get list of PO's to search for
lr = Sheet("Accrual & PO Data").Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet("Accrual & PO Data").Range("A1:A" & lr)
'Loop through sheets
For Each sh In ThisWorkbook.Worksheets
'Don't include PO Accrual Data


If sh.Name <> "Instructions" And _
sh.Name <> "Accrual & PO Data" And _
sh.Name <> "Tab Name List" And _
sh.Name <> "Subtotal Macro Button" And _
sh.Name <> "Input Date" And _
sh.Name <> "Summary FY19 F1(5)" And _
sh.Name <> "Summary FY19 F1(4)" And _
sh.Name <> "Summary FY19 F1(3)" And _
sh.Name <> "Summary FY19 F1(2)" And _
sh.Name <> "Summary FY19 F1" And _
sh.Name <> "EP Local" And _
sh.Name <> "Driver Definitions" And _
sh.Name <> "EP Global" Then




'Get list of PO's on current sheet
lr = sh.Cells(Rows.Count, 1).End(3).Row
If lr < 3 Then lr = 3 'There are blank sheets!
arS2 = sh.Range("A1:A" & lr)
'Loop through search PO's
For i = 2 To UBound(arS1)
'Loop through sheet PO's
For j = 3 To UBound(arS2)
'If there is a PO match, add it to the dictionary if not already in there
If arS1(i, 1) = arS2(j, 1) Then
If Not dic.Exists(arS2(j, 1)) Then dic.Add arS2(j, 1), Nothing
End If
Next
Next
End If
Next
'Loop through list to delete
For i = UBound(arS1) To 2 Step -1
'Loop through dictionary items
For Each ky In dic.Keys
'If there is a match. delete the PO row
If Sheet("Accrual & PO Data").Cells(i, 1) = ky Then Sheet1.Rows(i).Delete shift:=xlUp
Next
Next
'Show deleted PO's
kys = dic.Keys
If dic.Count <> 0 Then 'Can't print nothing!
Sheet1.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End If
Sheet1.Range("E" & dic.Count + 6) = Timer - tm & " seconds to complete."
End Sub

paulked
05-19-2020, 01:46 PM
It is probably unable to compile, not hang, because you haven't set reference to the Scripting Runtime.

Steve Belsch
05-19-2020, 03:03 PM
How do I set a reference? I have never used Scripting Runtime before.

Thanks.
Steve

paulked
05-19-2020, 04:07 PM
:bug: You have! See my post #41
You need to set the reference to the Microsoft Scripting Runtime. and then read your post #43
ok. I found that setting.

Anyway, here it is on a nice silver spoon, fresh from Google:

How do I enable Microsoft Scripting Runtime?

Setting the Reference to the Microsoft Scripting Runtime Library


In the VB Editor, click on Tools.
Click on References.
In the References dialog box that opens, scroll through the available references and check the 'Microsoft Scripting Runtime' option.
Click OK.

Steve Belsch
05-20-2020, 09:54 AM
Paulked,

It worked! One more question. What do I add to the code if I want to delete PO rows if there are multiple instance of that same number in the "PO & Accrual Data" worksheet. For example, there may be more than one in column A such as:



239618


239618


239618


239618


239618

Steve Belsch
05-20-2020, 10:06 AM
Paulked,

I run it an I do not get any breaks or error messages. However, it does not delete the rows in the "PO & Accrual Data" worksheet. But, you have the code here. Not sure why it is not executing that step? And it is a loop so it should be deleting all instances in that worksheet.

Any ideas?

I have attached the document.


'Loop through list to delete For i = UBound(arS1) To 2 Step -1
'Loop through dictionary items
For Each ky In dic.Keys
'If there is a match. delete the PO row
If Sheet153.Cells(i, 1) = ky Then Sheet278.Rows(i).Delete shift:=xlUp
Next
Next
'Show deleted PO's
kys = dic.Keys
If dic.Count <> 0 Then 'Can't print nothing!
Sheet278.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End If

Steve Belsch
05-20-2020, 10:08 AM
Paulked,

Here is the attachment that I forgot to add to the last thread.

Thanks.
Steve

paulked
05-20-2020, 11:46 AM
26704

Steve Belsch
05-20-2020, 02:05 PM
Paulked,

Ah! That was it, I had the wrong Sheet#! I now put this code into my 35M workbook. It is running, but taking a long time to run. The workbook has a lot of nested formulas which is what probably makes it big. Is there a way to speed it up? May put in Application.Calculation = xlCalculationManual? If so, would I put it in the loop or maybe at the top of the program?

Thanks for all of your expertise help! How did you learn VBA? I have learned a lot from you. But wondering how you became an expert.

Steve

paulked
05-20-2020, 02:19 PM
I'm no expert, but what I read I tend to retain.

If you are sure it is set to automatic before the code runs then set it to manual at the beginning, then set it back to automatic at the end, don't do it in the loop, it will slow things down even more!!!!!!!!!!!!!

Steve Belsch
05-20-2020, 04:43 PM
Paulked,

So I tried getting rid of all the formulas and set it to Manual and it was running for 2 hours and then Excel was "Not Responding". Any ideas what else I can do? It runs on the test workbook that I sent to you. But with the larger workbook it doesn't execute.

Thanks.
Steve

paulked
05-20-2020, 04:45 PM
I've no idea sorry, I've never seen your workbook... despite asking several times.

Steve Belsch
05-20-2020, 05:56 PM
Paulked,

The workbook is 35 Mega Bites and it is too large to attach here. That is why I sent you the test version, which is an exact replica with fewer worksheets.

Any other way I can get the file to you?

Regards,
Steve

Paul_Hossler
05-20-2020, 06:19 PM
Paulked, The workbook is 35 Mega Bites ...

That could be the reason it runs so slowly ... it might be time to re-think the approach and re-architect the workbook

paulked
05-20-2020, 06:41 PM
:yes That could hold the Vatican Library!!

Try saving is as an xlsb file, see what that does to the file size?

And get rid of ALL the formatting. I'm guessing you have filled the worksheets with colours... the whole of the sheets.

paulked
05-20-2020, 06:54 PM
Have a read of this https://www.excelefficiency.com/reduce-excel-file-size/

and this https://docs.microsoft.com/en-us/office/troubleshoot/excel/clean-workbook-less-memory

Steve Belsch
05-20-2020, 08:16 PM
Paul (Can I call you Paul),

But if I save it as a .xlsb file .... will that not run the Macro that you have helped me build?

Thanks.
Steve

Steve Belsch
05-20-2020, 08:20 PM
Paul,

I shut everything program down and the waited. Created a Macro to put every tab in Values. The CPU was almost at 100% the entire time but it worked!

Thank you so much for your help!!! You are my go to as I continue to learn VBA.

Steve

Steve Belsch
05-20-2020, 08:28 PM
Ah!!! Actually, i worked in terms of creating the list of used PO's but it did not delete the rows of the "Accrual & PO Data" worksheet. I don't get it. It worked on the test workbook. Ah!

paulked
05-20-2020, 08:59 PM
You can call me anything!

Do you think I would ask you to save it as a binary file if it wouldn't run a Macro?

You could save the file to a shared location (OneDrive, Dropbox, GoogleDrive etc) and share the link. At least I would have chance of finding the problem.

Steve Belsch
05-20-2020, 09:14 PM
Paul,

I just saved as a binary file as you suggested. let me try to save it in that location.

Thanks,
Steve

Steve Belsch
05-20-2020, 09:15 PM
Paul,

I just saved as a binary file as you suggested. let me try to save it in that location.

Thanks,
Steve

Steve Belsch
05-20-2020, 09:58 PM
Paul,

I have saved it to Drop Box. How do I send you a link?

Thanks.
Steve

Steve Belsch
05-20-2020, 10:03 PM
Paul,

Does this work?

https://www.dropbox.com/home?preview=F1+Med+Affairs+Build+v6+-+Test+New+Macro.xlsm

Thanks,
Steve

Steve Belsch
05-20-2020, 10:11 PM
https://www.dropbox.com/s/0lolld57ilobmkk/f1%20med%20affairs%20build%20v6%20-%20test%20new%20macro-xlsb.xlsb?dl=0

This should work.

Steve Belsch
05-20-2020, 10:14 PM
Paul,

Any more ideas on why this gets hung up. Even if you check out my "Vlaues" macro that should reduce time, but it just dose note even delete PO's.

Thanks,
Steve

Steve Belsch
05-21-2020, 04:23 AM
Paulked,

Are you able to see my full file?

Thanks,
Steve

paulked
05-21-2020, 04:50 AM
As I understand it, this is what you want to do:

1. Get all the PO's off the Accrual & PO Data sheet
2. Loop through all sheets
3. If the sheets are in the named list, don't do anything (skip them)
4. If the sheets are not in the named list, delete all the PO's that are in the Accrual & PO Data sheet off that sheet

Is that absolutely correct? Read it three times!!!

Steve Belsch
05-21-2020, 05:15 AM
Paul,

Yes. That is it.

can you see the file?

thanks,
steve

Steve Belsch
05-21-2020, 05:19 AM
Paul,

Any idea why it is so long to load?

thanks,
steve

paulked
05-21-2020, 05:32 AM
I can see the file.

Do you expect miracles? Didn't it take two hours on yours to run? I haven't got a Magic Wand!

Please wait... analysing data.

0% Complete
_______________________________________________

Paul_Hossler
05-21-2020, 07:12 AM
Several reasons that I can see for it being a large file and taking forever to load and calculate

I never bothered to let it calculate since it takes so l-o--o-n-g


1. There must be 10s of 1,000s of empty cells that have a formula in them that requires recalculating if any dependent data changes

2. There must be dozens of completely data-less sheets, filled with formulas

3. There is a lot of formatting in cells that takes space

4. Your worksheets go almost 20 years into the future with formulas, but no raw data into that time period

5. The XLSM format is a compressed ZIP under the hood - Just the main Excel unpacked (so Excel can get to it) is 216 MB, with just the worksheets using 196MB. So I'm guessing that there's a lot of paging going on

6. Your CalcChain.xml is almost 17 MB unpacked (I think it controls the order of cell calculation).

7. Some formulas are very complex and seem to require dependent data, forcing a re-calc. Also, many cells have that formula, but the cells that it uses are blank

See #64

26714

26716


26717

26718

26720

paulked
05-21-2020, 12:17 PM
Well explained Paul H, but I think you are being a bit kind there! I can only see two ways of dealing with that workbook, 1. Start again with a completely new design philosophy or 2. Pop down to PC World and purchase a new Acer 64QuBit Laptop.

Steve, this is the code:



Sub DelPOs()
Dim arS1 As Variant, arS2 As Variant, lr As Long, i As Long, j As Long, sh As Worksheet
Dim dic As New Scripting.Dictionary, ky As Variant, tm#
Dim rws As String, arRws As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
tm = Timer
'Get list of PO's to search for
lr = Sheets("Accrual & PO Data").Cells(Rows.Count, 1).End(3).Row
arS1 = Sheets("Accrual & PO Data").Range("A1:A" & lr)
For i = 2 To UBound(arS1)
If Not dic.Exists(arS1(i, 1)) Then dic.Add arS1(i, 1), Nothing
Next
uf1.Show
'Loop through sheets
For Each sh In ThisWorkbook.Worksheets

'Don't include the following sheets


If sh.Name <> "Instructions" And _
sh.Name <> "Accrual & PO Data" And _
sh.Name <> "Tab Name List" And _
sh.Name <> "Subtotal Macro Button" And _
sh.Name <> "Input Date" And _
sh.Name <> "Summary FY19 F1(5)" And _
sh.Name <> "Summary FY19 F1(4)" And _
sh.Name <> "Summary FY19 F1(3)" And _
sh.Name <> "Summary FY19 F1(2)" And _
sh.Name <> "Summary FY19 F1" And _
sh.Name <> "EP Local" And _
sh.Name <> "Driver Definitions" And _
sh.Name <> "EP Global" Then

uf1.Label1 = sh.CodeName & " (" & sh.Name & ")"
DoEvents

'Get list of PO's on current sheet
lr = sh.Cells(Rows.Count, 1).End(3).Row
If lr < 3 Then lr = 3 'There are blank sheets!
arS2 = sh.Range("A1:A" & lr)
'Loop through search PO's
rws = ""
For Each ky In dic.Keys
'Loop through sheet PO's
For j = UBound(arS2) To 3 Step -1
'If there is a PO match, delete row
If ky = arS2(j, 1) Then Worksheets(sh.Name).Rows(j).EntireRow.Delete shift:=xlUp
Next
Next
End If
Next
Unload uf1
MsgBox Timer - tm & " seconds to complete."
End Sub


It takes an age to run (every line it deletes takes just under 2 seconds!)

When the code has finished, the workbook wheezes for about 20 minutes trying to get over the shock of something worthwhile happening to it!

I put a userform in there which lets you know which sheet it is working on and the fact that it hasn't gone to sleep.

Seriously, re-think that workbook and its' pitfalls and then start again with fresh views. There are loads of people here willing to point you in the right direction, just ask... and, more importantly, take in the advice they give, it's priceless.

Attached is a slimmed down version of your file (I ran a script to delete all the empty rows on each sheet) with the uf in it.

Paul_Hossler
05-21-2020, 02:02 PM
1. Define the references on a sheet, small DB so that you can take decode fields into 'people-speak'. e.g.

Account = 1000 and see user = Bill
Account = 2000 and see user = Tom


2. Start with raw / unprocessed data either on one sheet or by using macro to pull it in from other sources / workbooks

3. Macro to process raw data sheet by ...

deleting rows or columns
formatting
adding new columns using decodes above
calculating any fields that will make reporting easier as VALUES, e.g. take PO date (5/1/2020) and store FY (05-2020) in a new column
Use SUM, SUMIF, COUNTIF, etc. as Application.WorksheetFunction if needed (intrinsic functions are faster than a VBA loop)

4. Use pivot tables to make analysis easier

5. Use macros to generate highly formatted 'reports' in separate workbooks, or l like to generate a report in a worksheet in the main book, but save it as a PDF and then delete the temporary worksheet from the main book