Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p>I think it would be simpler to use the AdvancedFilter method, but your data setup is important.</p> <p>I have assumed that your original data has Five columns (A:E), with headers being in Row 1 I have further assumed that the headers in columns A:C are "Collection", "System" and "Tag" I have also assumed there is nothing of importance on "Test" (If there is, instead of "clearing" the entire worksheet, you can alter the code to only clear the relevant part, perhaps the first four columns.</p> <p>Set up a criteria range (three columns, two rows) on your Imported Data sheet with the same headings in Row 1 as in columns A:C of your data source. You could use Data Validation to force an entry; or you could code something within the macro itself. Or you could develop a UserForm to populate these cells</p> <p>After your user fills in the criteria, the macro should copy the relevant data. If all three items are populated, it will delete column D, otherwise, it will delete columns D:E.</p> <p>If I've made some wrong assumptions about how your data is set up, you may need to delete more columns after doing the Filter.</p> <pre><code>Option Explicit Sub FilterButton() Dim SrcSheet As Worksheet, DestSheet As Worksheet Dim SourceRange As Range Dim CriteriaRange As Range Dim DestRange As Range With Application .ScreenUpdating = False .EnableEvents = False End With '~~&gt; Set your sheet Set DestSheet = Sheets("Test") Set SrcSheet = Sheets("Imported Data") '~~&gt; Set your ranges Set SourceRange = SrcSheet.Range("a1").CurrentRegion Set CriteriaRange = SrcSheet.Range("H1:J2") 'or wherever Set DestRange = DestSheet.Range("A1") 'Activate Destination Sheet, Clear it, and run the filter DestSheet.Activate 'Can only copy filtered data to active sheet DestSheet.Cells.Clear SourceRange.AdvancedFilter xlFilterCopy, CriteriaRange, DestRange 'Delete column D always, delete Column E if not three criteria With DestRange.CurrentRegion If WorksheetFunction.CountA(CriteriaRange.Rows(2)) &lt;&gt; 3 Then Range(.Columns(4), .Columns(5)).Delete Else .Columns(4).Delete (xlToLeft) End If End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload