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

lakersbg

New Member
Joined
Nov 11, 2010
Messages
20
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
 
I don't know what you are trying to do or the nature of your data.

Change this...
ActiveSheet.ShowAllData

To this...
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
 
Upvote 0

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
That seemed to of fixed that issue. The problem now is that it is asking me to save each unique values newly created workbook the same number of times the unique value appears in the sheet. So if "584" shows on the main sheet 100 times it saves the first instance fine, but then asks if I want to overwrite the already existing "584.xls" file another 99 times.

I have two other questions about this process. How can I tell it to copy and paste certain columns instead of the entire row and what about checking all the sheets in the workbook instead of just the current one? My spreadsheet is used to track parts purchased for projects that we are working on for our customers and can carry over for a few months. So the workbook contains a tab for each month and each tab gives us a list of what was purchased for that month. So when the code pulls out the unique values it is giving me a list of every part purchased for that customer's project throughout the months.
 
Upvote 0
If it helps at all, here is a bit of my November spreadsheet. I filter by column B and the columns go all the way to AF. Some of the formulas used pull info from an "Info" tab that is also in the workbook.

Excel 2003
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAF
LOCATION

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="align: center"]Customer Type[/TD]
[TD="align: center"]A/C[/TD]
[TD="align: center"]W/O[/TD]
[TD="align: center"]TASK[/TD]
[TD="align: center"]QTY[/TD]
[TD="align: center"]P/N[/TD]
[TD="align: center"]DESCRIPTION[/TD]
[TD="align: center"]ZONE[/TD]
[TD="align: center"]TASK WRITTEN[/TD]
[TD="align: center"]RCVD FOR PRICING[/TD]
[TD="align: center"]PRICED[/TD]
[TD="align: center"]DATE TO REP[/TD]
[TD="align: center"]REP APPVD[/TD]
[TD="align: center"]RCVD FROM REP[/TD]
[TD="align: center"]SORT CODE[/TD]
[TD="align: center"]PO/RO/CSP/Stock[/TD]
[TD="align: center"]Vendor[/TD]
[TD="align: center"]Date Order[/TD]
[TD="align: center"]Due Date[/TD]
[TD="align: center"]Recd[/TD]
[TD="align: center"]COST EACH[/TD]
[TD="align: center"]COST EXTENDED[/TD]
[TD="align: center"]LIST EACH[/TD]
[TD="align: center"]LIST EXTENDED[/TD]
[TD="align: center"]Profit Each[/TD]
[TD="align: center"]Profit Extended[/TD]
[TD="align: center"]SHIPPING TRACKING NUMBER[/TD]
[TD="align: center"]RECEIVING TRACKING NUMBER[/TD]
[TD="align: center"]COMMENTS[/TD]

[TD="align: center"]DATE ISSUED[/TD]
[TD="align: center"]DATE TO MX[/TD]

[TD="align: center"]2[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]584[/TD]
[TD="align: center"]18412[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/26/14[/TD]
[TD="align: center"]1,000.00[/TD]
[TD="align: center"]1,000.00[/TD]
[TD="align: center"]1,200.00[/TD]
[TD="align: center"]1,200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]584[/TD]
[TD="align: center"]18412[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/14/14[/TD]
[TD="align: center"]2,000.00[/TD]
[TD="align: center"]2,000.00[/TD]
[TD="align: center"]2,200.00[/TD]
[TD="align: center"]2,200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]4[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]NA[/TD]
[TD="align: center"]18436[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/21/14[/TD]
[TD="align: center"]500.00[/TD]
[TD="align: center"]500.00[/TD]
[TD="align: center"]575.00[/TD]
[TD="align: center"]575.00[/TD]
[TD="align: center"]75.00[/TD]
[TD="align: center"]75.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]5[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]584[/TD]
[TD="align: center"]18412[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]5,000.00[/TD]
[TD="align: center"]5,000.00[/TD]
[TD="align: center"]5,200.00[/TD]
[TD="align: center"]5,200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]6[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]584[/TD]
[TD="align: center"]18412[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/19/14[/TD]
[TD="align: center"]250.00[/TD]
[TD="align: center"]250.00[/TD]
[TD="align: center"]450.00[/TD]
[TD="align: center"]450.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]7[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]584[/TD]
[TD="align: center"]18412[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]250.00[/TD]
[TD="align: center"]250.00[/TD]
[TD="align: center"]450.00[/TD]
[TD="align: center"]450.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"]200.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]8[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3063[/TD]
[TD="align: center"]18423[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/25/14[/TD]
[TD="align: center"][/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]9[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3063[/TD]
[TD="align: center"]18423[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]11/25/14[/TD]
[TD="align: center"][/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]10[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3063[/TD]
[TD="align: center"]18423[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]11[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3063[/TD]
[TD="align: center"]18423[/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"]0.00[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

</tbody>
NOV14

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: #E0E0F0"]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]A2[/TH]
[TD="align: left"]=VLOOKUP(C2,AircraftInfo,3,0)[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]B2[/TH]
[TD="align: left"]=VLOOKUP(C2,AircraftInfo,2,0)[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]V2[/TH]
[TD="align: left"]=U2*E2[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]W2[/TH]
[TD="align: left"]=U2+Y2[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]X2[/TH]
[TD="align: left"]=W2*E2[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]Y2[/TH]
[TD="align: left"]=MIN(MAX(U2*INDEX(Markups,O2,3*(A2-1)+1),INDEX(Markups,O2,3*(A2-1)+2)),INDEX(Markups,O2,3*(A2-1)+3))[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]Z2[/TH]
[TD="align: left"]=X2-V2[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Workbook Defined Names[TABLE="width: 100%"]
<thead>[TR="bgcolor: #E0E0F0"]
[TH="width: 10px"]Name[/TH]
[TH="align: left"]Refers To[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]AircraftInfo[/TH]
[TD="align: left"]=Info!$A$16:$C$44[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]Markups[/TH]
[TD="align: left"]=Info!$B$4:$J$7[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi,

I a working on a project that is very similar in se ways to the data that Alphafrog has already displayed.

What I have created is a userform that gives the user a list of specific criteria to filter from Column C (Field 3). I then want to filter again all the data in Column Y (field 2) that is blank ie. value=""

From this I want to create a new workbook with a single sheet that copies the columns A,C,F,V,W,X from the filtered rows into the new sheet.

The data is on a veryhidden sheet ("sheet 2") that is populated by another user form. (however, the new user form is only to get the 'open' data (blanks in "Y") as I don't want all the data fro the sheet displayed)

I am close with some of the examples, but I isn't quite right.

(Excel 2003 - In use)

Thanks in advance for an help
 
Upvote 0
Hello AlphaFrog et al:

I've been going back and forth with this thread for the last few days trying to find the right code for my problem and I can't get one to work. (I had the same problem as another poster in that several scripts will open new sheets/workbooks and save, but not paste the data)

The data set:
I have several columns (A:F) with thousands of rows following a header row. The data is essentially distinct item numbers for each store (there are still hundreds of stores in the data). *There are no filters in this data.

What I'm trying to do:
1. Copy the header row and all rows for each store (i.e. if there are 12 rows for store #300, I would need to copy the header row and the 12 rows for store #300),
2. paste the header and data into a new workbook,
3. save the workbook according to the store number (column A),
4. close the workbook,
5. loop through the remaining stores until complete.
*these can all be saved in the same location as the original workbook.

So many thanks for all of those questions that came before me. This is a great thread!

Jonathan
 
Upvote 0
Hi Jonathan. Welcome to the forum.

The code in post #21 should do what you describe. Did you try that one? If yes, then are the sheets and file names of the destination workbooks the same as the column A unique values (store number in your case)?
 
Upvote 0
Alpha Frog I've got a question I'm hoping you can help with. I currently have the following macro that I've gotten from looking at your post which filters on column X and paste each unique value in its own worksheet titled with the name of the unique value. What I need now is for an additional macro that will filter column X for unique values like the previous macro but this time it will then look at column V and filter for "Yes" and then paste each of the unique values from column X that also have "Yes" in column V to separate worksheets titled with the name of the unique value_PMDPM. Any help is greatly appreciated!!

Sub Extract_All_Data_To_New_Worksheets()

'this macro assumes that your first row of data is a header row.
'will copy all filtered rows from one worksheet, to new worksheets in the same workbook
'each unique filtered value will be copied to it's own new sheet

'Variables used by the macro
Dim wsDest As Worksheet
Dim rngFilter As Range, rngUniques As Range
Dim cell As Range

' Set the filter range (from A1 to the last used cell in column A)
'(Note: you can change this to meet your requirements)
Set rngFilter = Range("X1", Range("X" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False

With rngFilter

' Filter column A to show only one of each item (uniques) in column A
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

' Set a variable to the Unique values
Set rngUniques = Range("X2", Range("X" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

' Clear the filter
ActiveSheet.ShowAllData

End With

' Filter, Copy, and Paste each unique to its own new worksheet
For Each cell In rngUniques

If cell.Value <> "" Then

' Create a new worksheet for each unique value
Set wsDest = Sheets.Add(After:=Sheets(Sheets.Count))

'NOTE - this filter is on column A (field:=1), to change
'to a different column you need to change the field number
rngFilter.AutoFilter Field:=24, Criteria1:=cell.Value

' Copy and paste the filtered data to its new worksheet
rngFilter.EntireRow.Copy
With wsDest.Range("A1")
.PasteSpecial xlPasteColumnWidths 'Paste column widths
.PasteSpecial xlPasteValuesAndNumberFormats 'Paste values
End With
Application.CutCopyMode = True

' Name the destination sheet
If Not Evaluate("ISREF('" & cell.Value & "'!A1)") Then 'Test if worksheet name already exists
wsDest.Name = cell.Value 'Name sheet
End If

End If

Next cell

rngFilter.Parent.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Code:
[color=darkblue]Sub[/color] Extract_All_Data_To_New_Worksheets()
    
    [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 new worksheets in the same workbook[/color]
    [color=green]'each unique filtered value will be copied to it's own new sheet[/color]
    
    [color=green]'Variables used by the macro[/color]
    [color=darkblue]Dim[/color] wsDest [color=darkblue]As[/color] Worksheet
    [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 X)[/color]
    [color=green]'(Note: you can change this to meet your requirements)[/color]
    [color=darkblue]Set[/color] rngFilter = Range("A1", Range("X" & Rows.Count).End(xlUp))
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=green]' Filter column X to show only one of each item (uniques)[/color]
    rngFilter.Columns("X").AdvancedFilter Action:=xlFilterInPlace, Unique:=[color=darkblue]True[/color]
    
    [color=green]' Set a range variable to the filtered Uniques[/color]
    [color=darkblue]Set[/color] rngUniques = Range("X2", Range("X" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    
    [color=green]' Clear the filter[/color]
    ActiveSheet.ShowAllData
    
    [color=green]' Filter, Copy, and Paste each unique to its own new worksheet[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] rngUniques
        
        [color=darkblue]If[/color] cell.Value <> "" [color=darkblue]Then[/color]
            
            [color=green]' Create a new worksheet for each unique value[/color]
            [color=darkblue]Set[/color] wsDest = Sheets.Add(After:=Sheets(Sheets.Count))
            
            [color=green]'NOTE - this filter is on column X (Field:=24), to change[/color]
            [color=green]'Change the field number to a different column if needed[/color]
            rngFilter.AutoFilter Field:=24, Criteria1:=cell.Value
            rngFilter.AutoFilter Field:=22, Criteria1:="Yes"            [color=green]'2nd "Yes" criteria in column V[/color]
            
            [color=green]' Copy and paste the filtered data to its new worksheet[/color]
            rngFilter.EntireRow.Copy
            [color=darkblue]With[/color] wsDest.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 Unique.Value & "_PMDPM"[/color]
            [color=darkblue]If[/color] [color=darkblue]Not[/color] Evaluate("ISREF('" & cell.Value & "_PMDPM.'!A1)") Then    [color=green]'Test if worksheet name already exists[/color]
                wsDest.Name = cell.Value & "_PMDPM"   [color=green]'Name sheet[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            
        [color=darkblue]End[/color] [color=darkblue]If[/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]
Please take note of my signature block below about the use of CODE tags. It makes reading the code in your posts much easier.
 
Last edited:
Upvote 0
Hi - I've scanned through all the relative posts and iterations, and have probably started to confuse myself!

I can get the advanced filter to filter my data on column N to two criteria and copy all rows to a separate worksheet, but I only want to copy rows where both criteria have a matching unique ID.

In other words Col A has an order number, and Col N a schedule of rates code applied for valuation purposes - so what I want to do is highlight those orders where a combination of both rates have been applied.

I hope that makes sense, and would be grateful if any one can signpost me to a solution. I often scour the threads for a solution but am mindful that I often create fairly crude vba.

Thanks - Neil
 
Upvote 0
Hi Alpha,

This is absolutely fabulous..... I have read throughout this post and you have replied to all the queries...it's really commendable well appreciated...

I was hoping that you could help me as well......I have searched thread but couldn't find some thing that suits me..

Well Here is my requirement,

I have multiple workbooks generated from our Email systems which contains the complete emails communicated which will be stored in to one folder. I have list of emails ID in one column which is in another sheet. Now i want to run a macro which will search through files for each cell value in the column of Email ID's and copy all the rows from multiple files in to one master workbook. I am trying with your code but couldn't really make it to work. I am totally a newbie in this whole VBA world. Any help would be highly appreciated.

To make it more clear ,

Lets say I have files named 1,2,3,4,5 etc(csv for xls*) in a directory C:\Files which might have around 20K-30K entries and columns from A to R. I have unique list of emailids in file email. Now I want to search the entire directory C:\Files for each unique ID in the email file and copy it to a new workbook with same name as the email ID. So lets say if I have 200 Email ID's then I am expecting 200 files one for each user.

Really a big thanks for the help.
 
Upvote 0

Forum statistics

Threads
1,224,847
Messages
6,181,325
Members
453,032
Latest member
Pauh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top