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

 

[My Aswer Is This]

Perhaps it would be best if you start a new thread.

I have created this script for him. Now he just wants it modified. Why would you think he should start a whole new thread?

Most moderators discourange starting new threads.

 

[AlphaFrog]

I have created this script for him. Now he just wants it modified. Why would you think he should start a whole new thread?

Most moderators discourange starting new threads.

No one discourages starting new threads except when is just a repeat same question by the same member. That is not the case here.

You (My Aswer Is This) hijacked a beautiful seven year old reference thread I had going with 120 uninterrupted replies and 60K views. Everyone else has respected the unspoken etiquette... until now.

 

[My Aswer Is This]

No one discourages starting new threads except when is just a repeat same question by the same member. That is not the case here.

You (My Aswer Is This) hijacked a beautiful seven year old reference thread I had going with 120 uninterrupted replies and 60K views. Everyone else has respected the unspoken etiquette... until now.

I'm sorry but a user posted his question in this thread and all I have done is tried to help him. Never knew I was suppose to tell poster to start new thread. I will ask him to do that.

 

[My Aswer Is This]

Kyotaki:

Please post your new question in a new posting. I will see it and see if I can help you more or as is the rule anyone else is also welcome to help you. A Moderator has requested a new thread be started.

Post a link here to your new thread

Hello, I'm back to this! During these weeks I have used this code for so many things, it is incredibly useful and I've spent many hours to customize it. I'd like to add a feature but I haven't been able to do it by myself. Is it possible to let the same sheetname for two different filters (eg:French people and German people) in order to get them filtered in the same sheet? My idea is that if the code find in the sheetname column a sheet already existent then "paste" the data below the one that was already filtered. Following the example above if I give the same sheetname (let's say Europeans) for the filters French people and German people, then I expect the macro to paste German people under the French ones in the Europeans sheet.

 

[AlphaFrog]

I'm not a moderator.

If you ever get a long lasting thread someday, and someone highjacks it, you'll understand.

 

[Kyotaki]

Dear all, I'm very sorry for having created any trouble, it was not my intention. I will create a new thread as requested.

 

[AlphaFrog]

Dear all, I'm very sorry for having created any trouble, it was not my intention. I will create a new thread as requested.

You didn't do anything wrong Kyotaki. No need to apologize. It was simply bad etiquette by My Aswer Is This. That's been my point all along.

Thank you for moving to a new thread.

 

[tcfreer]

Hi Alpha

Lovely piece of code that you have created here.

I'm using the version you wrote on the 3rd page for splitting out to different workbooks and saving these workbooks with a date stamp at the end

I have made a small change to the date format to dd-mmm-yyyyy

However I am trying to also link to another module that uses a static list and then creates a email, attaches the created files, and sends them (through Outlook)

Question 1 - In the code, were can I specify the sheet that is to be used for filtering, and change the column that it looks for the unique values in. The code is 'A', however I need to set this to 'E'

Question 2 - Can It save the name of the file and apply it to a cell on a row were the same filtered name is? So Cell e1= <othersheet>range a copy paste saved sheet link in matching row column d

Many thanks for all your help and taking time out to right these codes

 

[AlphaFrog]

[color=darkblue]Sub[/color] Extract_All_Data_To_New_Workbook()
    
    [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
    [B][color=darkblue]Dim[/color] shSource [color=darkblue]As[/color] Worksheet[/B]
    
    [B][color=darkblue]Set[/color] shSource = Sheets([COLOR="#FF0000"]"Sheet1"[/COLOR])    [color=green]'Source worksheet[/color][/B]
    
    [color=green]' Set the filter range (from E1 to the last used cell in column E)[/color]
    [color=green]'(Note: you can change this to meet your requirements)[/color]
    [color=darkblue]Set[/color] rngFilter = shSource.Range("[COLOR="#FF0000"]E1[/COLOR]", shSource.Range("[COLOR="#FF0000"]E[/COLOR]" & Rows.Count).End(xlUp))
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]With[/color] rngFilter
        
        [color=green]' Filter column E to show only one of each item (uniques) in column E[/color]
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=[color=darkblue]True[/color]
        
        [color=green]' Set a variable to the Unique values[/color]
        [color=darkblue]Set[/color] rngUniques = shSource.Range("[COLOR="#FF0000"]E2[/COLOR]", shSource.Range("[COLOR="#FF0000"]E[/COLOR]" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        
        [color=green]' Clear the filter[/color]
        [color=green]'shSource.ShowAllData[/color]
        shSource.Cells.AutoFilter
        
    [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 E (field:=5), to change[/color]
        [color=green]'to a different column you need to change the field number[/color]
        rngFilter.AutoFilter Field:=[COLOR="#FF0000"]5[/COLOR], 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, "dd-mmm-yyyy")
            
        [B][color=green]'Save the workbook path and name in adjacent cell 'Question 2[/color]
        [color=green]'cell.Offset(, -1).Value = wbDest.FullName[/color]
        cell.Parent.Hyperlinks.Add Anchor:=cell.Offset(, -1), _
            Address:=wbDest.FullName, TextToDisplay:=wbDest.Name[/B]
        
[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=darkblue]Sub[/color]

 

[tcfreer]

Hi Alpha

I'm having a small issue with this section

 ' Clear the filter
        'shSource.ShowAllData
        shSource.Cells.AutoFilter

I've set the shSource to my sheet

I get the Run-Time error 1004: AutoFilter method of Range class failed

Not sure what's causing it?

Regards

TC