VBA for Advance Filter

0
  1. Hey, 

So I have this Macro that advance filters a table with a pivot table being its criteria. And copies the result to another location. 

What I want it to do is:

1. Instead of pasting it anywhere as a new location, I want it to paste below the existing data of a new location. The new location is column BL and the existing data starts from BL3:CI3. 
How much further down does the existing data go  from BL3 ? Not fixed. It varies. 

2. End the macro with just having the first column of the newly pasted data as selected. 


Issue with the existing code:

  1. It does not copy below the existing data in column BL. It simply Pastes the new filtered data again from BL3.

  2. It does not select the first first column of the newly pasted data. 

This is how the new code looks (Please correct me if there is something wrong as I am very new to VBA)

Sub AdvanceFilter() 

Dim Table As ListObject 

Dim PT As PivotTable 

With ActiveSheet Set PT = .PivotTables("AdvanceFilterCriteriaPivot") 

Set Table = .ListObjects("Master_ALL") 

End With 

Table.Range.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=PT.TableRange1, CopyToRange:=Range("BL3:CI3"), Unique:=False Range("BL3", Range("BL" & Rows.Count).End(xlUp)).Select 
End Sub 


download link

https://1drv.ms/x/s!Ag2LsMLmSEbignTsPjuJ5O_8sMv1?e=IJshjx

Any Help is appreciated.

Answer
Discuss

Answers

0
Selected Answer

Asif

You say you want to paste extracted data below existing data. That's not a great idea to my mind (or will need some management so you don't have hundreds of rows of extracts) but I've added the date and time to each extract (using the VBA Now function). You'll see that I've added a new variable PasteCell (which is just below the last used row in column BL of the ALL_ENTRY sheet) which is convenient for some of the extra bits the macro does, especially the code in bold. 

The modified Module 7 code below is commented so you can see what's happening. It now adds the 1 in BK (used with your XLOOKUP in column B for shifting data) and adds a datestamp in column B if there isn't one (I've removed the Worksheet_Change event which did this before).

Note that I've changed the With from ActiveSheet (to the logical name Sheet2) and moved the End With line further down. The bold text replaces the (shorter) xlCopy version since I had lots of problems problems with that failing for no obvious reason (all the elements existed and were correct) and this seems more reliable.

The revised code below should do what you want (I think):

Sub AdvanceFilter()
Dim Table As ListObject
Dim PT As PivotTable
Dim PasteCell As Range, n As Long 'variable, target cell for top left of pasted data

'Apply speed up options
Application.EnableEvents = False ' prevent event macros triggering
Application.ScreenUpdating = False ' to speed up macro
Application.Calculation = xlCalculationManual ' stop calcs

With Sheet2 ' specify the sheet
    Set PT = .PivotTables("AdvanceFilterCriteriaPivot")
    Set Table = .ListObjects("Master_ALL")
    
    Set PasteCell = .Range("BL" & .Range("BL" & .Rows.Count).End(xlUp).Row + 3) 'get BL and last used row + 3

    ' change target for paste to the above and copy to BL:CI
    Table.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=PT.TableRange1, Unique:=False
    Table.Range.SpecialCells(xlCellTypeVisible).Copy Destination:=PasteCell
    .ShowAllData
    
    PasteCell.Offset(-1, 0).Value = Now 'add date and time above pasted data
    PasteCell.Offset(-1, 1).Value = "Extract:" 'add name after the above
    PasteCell.Resize(1, 28).Font.Color = vbBlack 'change pasted header row from white to black
    
    'Put 1 in column BK (for XLOOKUP)
    For n = PasteCell.Row + 1 To .Range("BL" & .Rows.Count).End(xlUp).Row
            .Range("BK" & n).Value = 1
         Next n
    PasteCell.Offset(1, 5).Select ' select a cell in pasted data

    'Turn calcs back on to evaluate XLOOKUP formulae
    
    .Calculate
    
    ' then add date if there's a 1 in C but no date in B
    For n = 3 To .Range("D" & .Rows.Count).End(xlUp).Row
        If .Range("C" & n).Value = 1 And .Range("B" & n).Value = "" Then .Range("B" & n).Value = Date
    Next n

End With

Application.EnableEvents = True 'reset events, screen and calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Paid items pasted and timestamps applied to B:C" 'tell user it's done

End Sub
Please use the attached revision to your workbook, in which BL:CI is currently blank so you can (if necessary) change the Auto Filter Criteria and run the macro (a few times to see it works).

Note that the conditional formatting in column C has been changed to that in the additional sheet called Conditional Formatting and the XLOOKUP formula in C now goes to rows 1999 (rather than the bigger 9999 you had)- you might change that if you find that the calculation within the macro isn't slowed down by that.

Hope this is what you wanted (or you can modify it slightly to suit)..

Discuss

Discussion

John,

Before moving further allow me to tell you what am I trying to achive with my workbook:
>> Advance Filter data  to new location. (Your above code lets me do that)

>> Mark the cell left to the first column of the newly pasted data  as 1.( Mark as paid macro lets me do that)

>> Use Xlookup to return this 1 beside the matching corresponding row in the main data source (from where the data was filtered) 

>> Conditional format turns this 1  into a green tick mark letting me know that the Payment as been made. + your Date Macro records the date when this 1 is added  letting me know when was it made.
asif_187 (rep: 4) Aug 1, '21 at 2:16 am
First of all immensly thankful for helping me out. You've been awesome ! 
Secondly, Really liked msg box touch.
Thirdly,  I am facing the following issues after applying this code:

1. I want the macro to leave me  the first column of the newly pasted data as selected. (So that i can simply add 1 beside them with just one click)

2. After applying the above code, the conditional formatting in Column C:C (that turns all the 1s to green tick marks)  is gone. When I re-applied it i was left with both a tick mark and a 1 in same cell ( eg: C195)

3. The filtering process takes a lot of time "Calculating" when we run the macro. Not just that, after applying the above code, the worksheet randomly keeps "Calculating" even when the marco is not run, making the overall process of using the workbook very time consuming.

Before your Code: https://1drv.ms/x/s!Ag2LsMLmSEbignuLtgoqrK348BgB?e=SPXMVm

After your Code: https://1drv.ms/x/s!Ag2LsMLmSEbigno0yWaO8UW6kYp8?e=cBRvRq

Please help me tune my codinigs.
asif_187 (rep: 4) Aug 1, '21 at 2:16 am
Asif

I didn't change the conditional formatting in C or  the XLOOKUP there (or even look at it- your question made no mention of them) but I now see that you've used my "multiple timestamp" code from your previous question. The repeat Calculating could arise from triggerring multiple events (and the Worksheet_Change event macro)

Is that column supposed to be linked to the 1 entries in column BK somehow or what is the purpose of BK?  (it might be easier to do in the macro)

Not sure if I'll have another chance to look at this today but (in your original question) please explain what running the macro means (e.g. is that filtered group paid?) I don't have the time to understand how your entire workbook operates so need clues from you!
John_Ru (rep: 2467) Aug 1, '21 at 3:54 am
Hi,

I didn't change the conditional formatting in C or  the XLOOKUP
This is solved. there was a silly error from my side.

but I now see that you've used my "multiple timestamp" code from your previous question. 
Absolutely Correct.

is that filtered group paid?
Yes

what is the purpose of BK? 
Is that column supposed to be linked to the 1 entries in column BK (it might be easier to do in the macrowhat running the macro means (e.g. is that filtered group paid?) need clues from you!

Okay, So let me tell you. The table Master ALL appends Tables  from multiple files. I then use this Master ALL table to make Payments. To mark which entry's payment has been made I am putting a 1 beside that entry. To make this 1 simpler to read and understand  I am using using conditional formatting to turn the 1s into a tick mark. And to know when was this paymenyt made, I am using your time stamp Macro.
asif_187 (rep: 4) Aug 1, '21 at 1:30 pm
The best way would have been to simply filtrer Master ALL in its place and put a tick mark in C. But since Master ALL is created by appending mutiple tables, the position of the content in the table keeps changing. For example if i have "hello" in D1 and I refresh the table, This hello now shifts to may be D2 or D5 or god knows where. And  had I marked it as paid earlier in C1, then C1  would still be showing a tick mark where as the content of it's correspondinig Columns: D1:AE1 would have been long gone from there. So now what i am left with is a tick mark but to a different entry.

To Tackle this issue I needed the contents of the Table MsterALL to be Static Hence i thought of filtering it to another location: BL and mark BK: as 1 (to denote its paid) and then use X lookup in C to return this 1 against the matching entry.
asif_187 (rep: 4) Aug 1, '21 at 1:45 pm
Using Module 7 to filter data to BL.
Using Module 8 to print 1 in BK to denote them as paid.
Using X lookup to to find the matching filtered data in MasterALL and return Correspondong BK's Value in Column C.
Converting this 1 in C to a tick mark for sake of convenience.
B records the time stamp when the value of C changes.

This way everything from Bk to whatever would be my helper column to get the results I want near my Main Data: MasterALL

For conveninece sake I wanted Module 7 to leave me  the first column of the newly pasted data as selected. So that when I run Module 8 i dont have to reselect the same data again.

Hope all is clear now. Its really Simple.

"Calculation" is still taking a Staggering amount of time.

Since a new month has already started I was hoping to be done with this in a day or two. Once Again you have been I M M E N S E L Y  helpful and patient. Grateful.
asif_187 (rep: 4) Aug 1, '21 at 1:45 pm
Asif

Thanks for the explanation. Will look at it tomorrow. 
John_Ru (rep: 2467) Aug 1, '21 at 2:19 pm
Asif

I don't have your external data sources so what happens to the paid timestamps when the MasterAll table is refreshed (via Module2/ Sub RefreshMasterALLENTRY say)?

I sk since you said earlier "... the position of the content in the table keeps changing...  ...had I marked it as paid earlier in C1, then C1  would still be showing a tick mark where as the content of it's corresponding Columns: D1:AE1 would have been long gone from there" so that applies to (dates in) column B too, right?

Incidentally I suspect that the recalculation delays arise from using many cells with XLOOKUP and the Worksheet_Change event. I'm hoping to think of a way to bypass that within the macro.
John_Ru (rep: 2467) Aug 2, '21 at 5:27 am
Asif

Please try the revised answer and attached file - it should be fast enough and do what you want in one go (since I added the speed up elements at start/ end of the macro).

I had lots of problems with the line:
Table.Range.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=PT.TableRange1, CopyToRange:=PasteCell, Unique:=False
and wasted a lot of time trying to find the issue. In the end I had to use three lines instead.
John_Ru (rep: 2467) Aug 2, '21 at 4:51 pm
Asif

Forgot to say that I selected  a pasted data cell but before screenupdating was restored (since I set column BK to 1s anyway and added the date stamps in B).
John_Ru (rep: 2467) Aug 3, '21 at 9:18 am
My man ! Are you the best or what !
Works like a charm.

Just a little thing, now that the whole working procedure of marking entries as paid has changed and since all my payments are calculated from the labour page, I moved the the Filter button to the Labour Page. Having some issues while running from there. could you have a look ? Please ? Apart from this everytging is as i wanted.
asif_187 (rep: 4) Aug 3, '21 at 11:45 am
Asif

Glad it worked for you.

I made a new button on Conditional Formatting sheet (which you can delete) instead, did right click/ Assign Macro/ picked AdvancedFilter and found the macro failed at this line:
PasteCell.Offset(1, 5).Select ' select a cell in pasted data
I think that's because Sheet2 wasn't active (since the macro was launched from a button on another sheet) so selecting isn't a good idea) but I just commented it out (i.e. put an apostrophe at the start of the line) and it worked okay.

Hope this fixes the issue for you because I don't want to spend more time on this.

If it does, please mark the Answer as Selected- other users find that useful in solving their problems and it increases my reputation (ever so slightly- if only it paid some money, haha!).

p.s. where do you modify the PivotTable filter now? I was changing that on the ALL_ENTRY sheet.rather than Labour
John_Ru (rep: 2467) Aug 3, '21 at 12:04 pm
Did that work for you, Asif? 
John_Ru (rep: 2467) Aug 5, '21 at 3:59 am
Hey, 
Super Sorry for replying late. Was ill. Works Good.  Marked as answered.
(if only I was paid enough to pay you, haha!)

Writing to you from work. Saturdays are the payment day and today its put to test.

There is one slight angle that we missed.

Problem:
Just like how we made the 1s in C Dynamic to the corresponding  entries in the table we also need to make the time stamp dynamic.

Because whats happening is: with new entries (after refreshing), everything shifts its place. But the time stamp remains static.

Solution:
Insted of putting the time stamp in B I want it in BJ. (Just beside BK (the place where we put 1 earlier)
I can then use Xloookup to reflect it in B (Just like what we did in C)

Where I need your help: I dont know what to change in the code to make the time stamp appear in BJ instead of B.

Could you, PLEASE, once again, be patient enough to make the necessary changes in the codeing ?

Thanks man. Really appreciate your help so far. (if only i knew coding) 
asif_187 (rep: 4) Aug 7, '21 at 4:35 am
Asif.
Thanks for selecting my Answer. Sorry to hear you've been ill, hope you're fit now. For that reason, I'll reply to your extended question (it isn't normal to do so...)

I'm losing track of your workbook now but think I just need to remove the section  starting "' then add date if there's a 1 in C but no date in B".. (before the End With) and make the changes in bold in the next Discussion points below.

Note that I didn't see any point in putting a 1 in column BK so put the date there instead (rather the BJ). Hope this fixes things for you.

Regarding your comment "(if only i knew coding)", you can start here, in the Excel Tutorials section listed in the menu bar of this page. A good place to begin is  the lesson  Excel Macros Class 1 - Getting Started Programming Macros which is the first of 6 easy lessons to get you going and allow you to understand other VBA tutorials there. Good luck!
John_Ru (rep: 2467) Aug 7, '21 at 6:56 am
Sub AdvanceFilter()
Dim Table As ListObject
Dim PT As PivotTable
Dim PasteCell As Range, n As Long 'variable, target cell for top left of pasted data
 
'Apply speed up options
Application.EnableEvents = False ' prevent event macros triggering
Application.ScreenUpdating = False ' to speed up macro
Application.Calculation = xlCalculationManual ' stop calcs
 
With Sheet2 ' specify the sheet
    Set PT = .PivotTables("AdvanceFilterCriteriaPivot")
    Set Table = .ListObjects("Master_ALL")
    
    Set PasteCell = .Range("BL" & .Range("BL" & .Rows.Count).End(xlUp).Row + 3) 'get BL and last used row + 3
 
    ' change target for paste to the above and copy to BL:CI
    Table.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=PT.TableRange1, Unique:=False
    Table.Range.SpecialCells(xlCellTypeVisible).Copy Destination:=PasteCell
    .ShowAllData
    
    PasteCell.Offset(-1, 0).Value = Now 'add date and time above pasted data
    PasteCell.Offset(-1, 1).Value = "Extract:" 'add name after the above
    PasteCell.Resize(1, 28).Font.Color = vbBlack 'change pasted header row from white to black
 
John_Ru (rep: 2467) Aug 7, '21 at 7:00 am
'Put date in column BK (for XLOOKUP)
    PasteCell.Offset(0, -1).Value = "Date paid" ' Add column heading in BK
    For n = PasteCell.Row + 1 To .Range("BL" & .Rows.Count).End(xlUp).Row
            .Range("BK" & n).Value = Date ' insert today's date
         Next n
    'PasteCell.Offset(1, 5).Select ' select a cell in pasted data
 
    'Turn calcs back on to evaluate XLOOKUP formulae
    
    .Calculate
    
 
End With
 
Application.EnableEvents = True 'reset events, screen and calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
MsgBox "Paid items pasted with timestamps in column BK" 'tell user it's done
 
End Sub
Sorry but the 1,500 character limit per Discussion point meant I had to split the new code over 2 points.

Trust you can paste them together to form the full macro.
John_Ru (rep: 2467) Aug 7, '21 at 7:01 am
D O N E !!



THANK YOU FOR YOUR PATIENCE.

let me go through Macro Lessons.
asif_187 (rep: 4) Aug 8, '21 at 4:13 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login