VBA:copy rows based on criteria to a new sheet/file.

[lakersbg]

Dear Excel pros,
Unfortunately I don't know much about the VBA language so I'll appreciate it if you could help me on the following macro:
Each month I get two files with data which I have to reconcile (find for each customer account (let's say each unique value in column A) the rows that are missing in one of the two files. So, I want to do a macro which would help me, once I've put the data into one sheet and sorted on Column A, to copy the rows containing each unique value in A (each customer) into a new sheet/file. After that I can easily delete the duplicate rows and see what is missing from one of the files.
I found a macro that more or less suits me, but I need to make it repeat itself for each unique value in Column A (or from a list of values if it will be easier).
Here is the macros that I found, you can modify it to suite my purpose. Big thank you in advance!
Best Regards,
Lakersbg

Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is a 0 in column N
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

'Get the current file's name
CurrentFileName = ActiveWorkbook.Name
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS3000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = Range("Sheet2!A1").Value
'NOTE - this filter is on column A (field:=1), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=1, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
Workbooks.Add Template:="Workbook"
'Get this file's name
NewFileName = ActiveWorkbook.Name
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
Workbooks(CurrentFileName).Activate
'Clear the autofilter
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[Icesurf3r]

Re: VBA: autofilter criteria

Hi AlphaFrog,

I shouldn't have been so hasty in my reply above. After a bit of investigating, I realised that I had added a blank row in at A, so I all I needed to do was change the ("A1") reference to ("A2"). However, The code copies all data regardless of whether Column D says yes or no, so I'm not sure if I've caused an error in changing the code.

I would however, like the new workbook that is created to have exactly the same formatting as the worksheet where the data is extracted from i.e. column width, text/cell colour etc. and that is way beyond my (Very) basic skills. Could I impose on you to expand the above code to take this into account, if it is possible?

Thanks again.

 

[AlphaFrog]

Re: VBA: autofilter criteria

Try this...

[color=darkblue]Sub[/color] Yes()
    
    [color=darkblue]With[/color] Worksheets("Initiative Tracker")
    
        [color=darkblue]If[/color] .FilterMode [color=darkblue]Then[/color] .ShowAllData
        
        [color=darkblue]With[/color] .Range("A2").CurrentRegion
            .AutoFilter Field:=4, Criteria1:="Yes"
            Workbooks.Add xlWBATWorksheet
            .SpecialCells(xlCellTypeVisible).Copy
            Range("A2").PasteSpecial xlPasteColumnWidths
            Range("A2").PasteSpecial xlPasteAll
            Range("A2").PasteSpecial xlPasteValues
            .AutoFilter
            Application.CutCopyMode = [color=darkblue]False[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

It may be easier to just copy the sheet then delete the the rows on the copied sheet that don't equal Yes

[color=darkblue]Sub[/color] Yes()
    
    Worksheets("Initiative Tracker").Copy
    
    [color=darkblue]If[/color] ActiveSheet.FilterMode [color=darkblue]Then[/color] ActiveSheet.ShowAllData
    
    [color=darkblue]With[/color] ActiveSheet.Range("A2").CurrentRegion
        .AutoFilter Field:=4, Criteria1:="<>Yes"
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[Icesurf3r]

Re: VBA: autofilter criteria

Alphafrog,

Thank you for your suggestions above, the first piece of code worked flawlessly.

Building upon the idea, I have been asked if it's possible to use a dropdown list or listbox to select a value which would then be used to populate the Criteria1:= value?

So rather than a fixed value the user has a choice. Both myself and a colleague have scratched our heads over this for the last few days, and no matter what we try, we couldn't work out how to pass the selected value in the list through to the Criteria1:= value.

Is this something you could help with?

 

[AlphaFrog]

Re: VBA: autofilter criteria

You're welcome.

Change the Sheet name and cell address for your dropdown.

Sub Yes()
    
    With Worksheets("Initiative Tracker")
    
        If .FilterMode Then .ShowAllData
        
        With .Range("A2").CurrentRegion
            .AutoFilter Field:=4, Criteria1:=[COLOR="#FF0000"]Worksheets("Sheet1").Range("A1").Value[/COLOR]
            Workbooks.Add xlWBATWorksheet
            .SpecialCells(xlCellTypeVisible).Copy
            Range("A2").PasteSpecial xlPasteColumnWidths
            Range("A2").PasteSpecial xlPasteAll
            Range("A2").PasteSpecial xlPasteValues
            .AutoFilter
            Application.CutCopyMode = False
        End With
    End With
End Sub

 

[Icesurf3r]

Re: VBA: autofilter criteria

You sir, are a genius

Thank you very very much for your help. Again your code works like a charm and has made sure I don't need buttons everywhere for people to extract the MI that they need.

I'm going to try and develop your code provided in the above post so it will actually cut the entire row and paste it into a new worksheet and delete the blank row (where the data has been cut from).

If I can't work it out, you may well hear from me again lol.

But can't thank you enough for your help so far.

 

[Icesurf3r]

Re: VBA: autofilter criteria

Well I've already managed to break your original code somehow. The initiative tracker worksheet is formatted as a table and both sets of code:

[COLOR=darkblue]Sub[/COLOR][COLOR=#333333] Yes()[/COLOR]    
    [COLOR=darkblue]With[/COLOR] Worksheets("Initiative Tracker")
    
        [COLOR=darkblue]If[/COLOR] .FilterMode [COLOR=darkblue]Then[/COLOR] .ShowAllData
        
        [COLOR=darkblue]With[/COLOR] .Range("A2").CurrentRegion
            .AutoFilter Field:=4, Criteria1:="Yes"
            Workbooks.Add xlWBATWorksheet
            .SpecialCells(xlCellTypeVisible).Copy
            Range("A2").PasteSpecial xlPasteColumnWidths
            Range("A2").PasteSpecial xlPasteAll
            Range("A2").PasteSpecial xlPasteValues
            .AutoFilter
            Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR] [COLOR=darkblue]End[/COLOR][COLOR=darkblue]Sub[/COLOR]

And

Sub Yes()    
    With Worksheets("Initiative Tracker")
    
        If .FilterMode Then .ShowAllData
        
        With .Range("A2").CurrentRegion
            .AutoFilter Field:=4, Criteria1:=Worksheets("Sheet1").Range("A1").Value
            Workbooks.Add xlWBATWorksheet
            .SpecialCells(xlCellTypeVisible).Copy
            Range("A2").PasteSpecial xlPasteColumnWidths
            Range("A2").PasteSpecial xlPasteAll
            Range("A2").PasteSpecial xlPasteValues
            .AutoFilter
            Application.CutCopyMode = False
        End With
    End With
End Sub

Worked absolutely flawlessly, until I added a column to the end of the table. I now get a Run-time error '1004': AutoFilter method of Range class failed and the following line of code is highlighted:

.AutoFilter Field:=4, Criteria1:="Yes"

I can't quite work out why adding a column would break it? The column referenced in the AutoFilter Field:= 4 reference is still in the same place within the table. Please could you help again?

 

[thecdnmole]

Re: VBA: autofilter criteria

Good day AlphaFrog! One of your original codes is almost exactly what I have been needing for a project! But, I was wondering how one would be able to add some variability to the code, so that the user has a choice as to what column or columns are filtered (not hard coded as column "A") as well as being able to choose which column/s are not copied to the new workbook? For example, I may want to filter column A & C and create new workbooks based on this, possibly named by column A, but I do not want column B copied and pasted in the new workbooks created. Will this be difficult to do? I have attached the code you wrote which I like, but needs the above changes to work perfect in my case. Thanks!

[COLOR=darkblue]Sub[/COLOR][COLOR=#333333] Extract_All_Data_To_New_Workbook()[/COLOR]    
    [COLOR=green]'this macro assumes that your first row of data is a header row.[/COLOR]
    [COLOR=green]'will copy all filtered rows from one worksheet, to another blank workbook[/COLOR]
    [COLOR=green]'each unique filtered value will be copied to it's own workbook[/COLOR]
    
    [COLOR=green]'Variables used by the macro[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] wbDest [COLOR=darkblue]As[/COLOR] Workbook
    [COLOR=darkblue]Dim[/COLOR] rngFilter [COLOR=darkblue]As[/COLOR] Range, rngUniques [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] cell [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=green]' Set the filter range (from A1 to the last used cell in column A)[/COLOR]
    [COLOR=green]'(Note: you can change this to meet your requirements)[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rngFilter = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] rngFilter
        
        [COLOR=green]' Filter column A to show only one of each item (uniques) in column A[/COLOR]
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=[COLOR=darkblue]True[/COLOR]
        
        [COLOR=green]' Set a variable to the Unique values[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rngUniques = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        
        [COLOR=green]' Clear the filter[/COLOR]
        ActiveSheet.ShowAllData
        
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    [COLOR=green]' Filter, Copy, and Paste each unique to its own new workbook[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] rngUniques
    
        [COLOR=green]' Create a new workbook for each unique value[/COLOR]
        [COLOR=darkblue]Set[/COLOR] wbDest = Workbooks.Add(xlWBATWorksheet)
                
        [COLOR=green]'NOTE - this filter is on column A (field:=1), to change[/COLOR]
        [COLOR=green]'to a different column you need to change the field number[/COLOR]
        rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
        
        [COLOR=green]' Copy and paste the filtered data to its new workbook[/COLOR]
        rngFilter.EntireRow.Copy
        [COLOR=darkblue]With[/COLOR] wbDest.Sheets(1).Range("A1")
            .PasteSpecial xlPasteColumnWidths           [COLOR=green]'Paste column widths[/COLOR]
            .PasteSpecial xlPasteValuesAndNumberFormats [COLOR=green]'Paste values[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        Application.CutCopyMode = [COLOR=darkblue]True[/COLOR]
        
        [COLOR=green]' Name the destination sheet[/COLOR]
        wbDest.Sheets(1).Name = cell.Value
        
        [COLOR=green]'Save the destination workbook and close[/COLOR]
        wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
            cell.Value & " " & Format(Date, [COLOR=#ff0000]"mmm_dd_yyyy"[/COLOR])
[COLOR=green]'        wbDest.Close False 'Close the new workbook[/COLOR]
        
    [COLOR=darkblue]Next[/COLOR] cell
    
    rngFilter.Parent.AutoFilterMode = [COLOR=darkblue]False[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
     [COLOR=darkblue]End[/COLOR][COLOR=#333333] [/COLOR][COLOR=darkblue]Sub[/COLOR]

 

[AlphaFrog]

Re: VBA: autofilter criteria

Will this be difficult to do?

It's not too difficult, but I think it's beyond the scope of this thread. Your request has more to do with creating a UserForm interface or a series of prompts to the user.

Perhaps you should paste the code to a new thread and clearly define exactly what you want. This is a little too vague.

I may want to filter column A & C and create new workbooks based on this, possibly named by column A, but I do not want column B copied and pasted in the new workbooks created.

Also, think it through carefully. It can be frustrating for everyone to have to later ask for additional features or changes. Sometimes what seems like a simple request to change something after a version of code is provided can mean drastic change in how the task is accomplished in the code.

 

[Kyotaki]

Re: VBA: autofilter criteria

Dear all this thread is just magic. Alpha I've gone through your brilliant codes, I'd like to know if you can help with my small macro. I need to split data like the following (I've created a data sample to play with it with macros):

Screen from sheet data:

I need to filter it using categories in columns in country and sex. The data should be copied to a new sheet in the same workbook. My problem is that I need a file easily customizable, for this reason so the filter criteria should be in a cell that anybody would be able to change. For this reason I created a new sheet (INFO) where the filter is specified..


Screen from INFO sheet:

In this example I need to copy paste data for French females to the sheet FranceFemale, then data for German males to GermanMale and data for all Italian entries to sheet Italy.

The important thing is that I need to be able to customize the filter just changing these cells (eg: adding more countries).


Could you advise me a way to do this?

 

[Kyotaki]

Re: VBA: autofilter criteria

I don't know the reason but I cannot post the original data to the forum (maybe some anti-spam filter due to the email column), I've adapted it so it can be easily used:

DATA:
[TABLE="width: 360"]
<colgroup><col width="72" span="5" style="width:54pt"> </colgroup><tbody>[TR]
[TD="class: xl66, width: 72"]id[/TD]
[TD="class: xl66, width: 72"]first_name[/TD]
[TD="class: xl66, width: 72"]last_name[/TD]
[TD="class: xl66, width: 72"]gender[/TD]
[TD="class: xl66, width: 72"]country[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]1[/TD]
[TD="class: xl66"]Cheryl[/TD]
[TD="class: xl66"]Clark[/TD]
[TD="class: xl66"]Female[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]2[/TD]
[TD="class: xl66"]Joyce[/TD]
[TD="class: xl66"]Harrison[/TD]
[TD="class: xl66"]Female[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]3[/TD]
[TD="class: xl66"]Donald[/TD]
[TD="class: xl66"]Diaz[/TD]
[TD="class: xl66"]Male[/TD]
[TD="class: xl66"]Germany[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]4[/TD]
[TD="class: xl66"]Debra[/TD]
[TD="class: xl66"]Dixon[/TD]
[TD="class: xl66"]Female[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]5[/TD]
[TD="class: xl66"]Doris[/TD]
[TD="class: xl66"]Reid[/TD]
[TD="class: xl66"]Female[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]6[/TD]
[TD="class: xl66"]Bobby[/TD]
[TD="class: xl66"]Adams[/TD]
[TD="class: xl66"]Male[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]7[/TD]
[TD="class: xl66"]Tammy[/TD]
[TD="class: xl66"]King[/TD]
[TD="class: xl66"]Female[/TD]
[TD="class: xl66"]Germany[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]8[/TD]
[TD="class: xl66"]Harry[/TD]
[TD="class: xl66"]Adams[/TD]
[TD="class: xl66"]Male[/TD]
[TD="class: xl66"]Italy[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]9[/TD]
[TD="class: xl66"]Matthew[/TD]
[TD="class: xl66"]Alvarez[/TD]
[TD="class: xl66"]Male[/TD]
[TD="class: xl66"]France[/TD]
[/TR]
[TR]
[TD="class: xl66, align: right"]10[/TD]
[TD="class: xl66"]Alan[/TD]
[TD="class: xl66"]Thompson[/TD]
[TD="class: xl66"]Male[/TD]
[TD="class: xl66"]Germany
[/TD]
[/TR]
</tbody>[/TABLE]


CRITERIA:
[TABLE="width: 241"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Sheetname[/TD]
[TD]country[/TD]
[TD]gender[/TD]
[/TR]
[TR]
[TD]FranceFemale[/TD]
[TD]France[/TD]
[TD]Female[/TD]
[/TR]
[TR]
[TD]GermanyMale[/TD]
[TD]Germany[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]Italy[/TD]
[TD]Italy[/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]


Hopefully, it will be useful.