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
 
This script I believe meets all your wishes including in country is blank and sex = Male.
The one problem I still cannot figure out is why the last county entered into sheet "info" and if the sex is left blank it will not pull in all the sexes. it only fails to work in the last one entered into sheet info.

I have looked at this all day and cannot figure that out but I don't like giving up.
When I figure that out I will get back with you.

See if this new part works:

Second example:
If in my criteria the country is empty and sex is male, I want male people from all the countries.
I assume you wanted male hard coded in and would never want country empty and sex female. But if I did not understand correctly let me know.

Code:
Sub FilterMini()
'Modified 3-19-17 11:00 PM EST
Dim i As Long
Dim Lastrow As Long
Dim SheetName As String
Dim Sex As String
Dim Country As String
Dim One As String
Dim Two As String
One = "Data" 'Modify name here if needed
Two = "Info" 'Modify name here if needed
Lastrow = Sheets(Two).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(One).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To Lastrow
SheetName = Sheets(Two).Cells(i, "A").Value
Country = Sheets(Two).Cells(i, "B").Value
Sex = Sheets(Two).Cells(i, "C").Value
Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
With Sheets(One).Range("A1:G" & Lastrowa)
If Len(Country) = "0" And Sex = "Male" Then
.AutoFilter Field:=7, Criteria1:="*", Operator:=xlFilterValues
.AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
Else
If Len(Country) > 0 Then .AutoFilter Field:=7, Criteria1:=Country, Operator:=xlFilterValues
If Len(Sex) > 0 Then .AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
End If

.SpecialCells(xlCellTypeVisible).Copy Worksheets(SheetName).Range("A1")
End With
Next
Sheets(One).AutoFilterMode = False
End Sub
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
OK. I found the problem.
Try this:
This script I believe meets all your wishes including in country is blank and sex = Male.

Your Quote: If in my criteria the country is empty and sex is male, I want male people from all the countries.
I assume you wanted male hard coded in and would never want country empty and sex female. But if I did not understand correctly let me know.

Code:
Sub FilterMini()
'Modified 3-20-17 4:15 AM EST
Dim i As Long
Dim Lastrow As Long
Dim SheetName As String
Dim Sex As String
Dim Country As String
Dim One As String
Dim Two As String
One = "Data" 'Modify name here if needed
Two = "Info" 'Modify name here if needed
Lastrow = Sheets(Two).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(One).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To Lastrow
SheetName = Sheets(Two).Cells(i, "A").Value
Country = Sheets(Two).Cells(i, "B").Value
Sex = Sheets(Two).Cells(i, "C").Value
Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
With Sheets(One).Range("A1:G" & Lastrowa)
If Len(Country) = "0" And Sex = "Male" Then
.AutoFilter Field:=7, Criteria1:="*", Operator:=xlFilterValues
.AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
Else
If Len(Country) > 0 Then .AutoFilter Field:=7, Criteria1:=Country, Operator:=xlFilterValues
If Len(Sex) > 0 Then .AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
End If
.SpecialCells(xlCellTypeVisible).Copy Worksheets(SheetName).Range("A1")
End With
Sheets(One).AutoFilterMode = False
Next
Sheets(One).AutoFilterMode = False
End Sub
 
Upvote 0
If you wanted country to be empty and then choose Female or Male:
In column B on sheet info remove country name and put sex you want in column C
This would then find all countries female or males depending on what you have in column C

And use this script:

Code:
Sub FilterMini()
'Modified 3-20-17 4:35 AM EST
'Male not Hardcoded
Dim i As Long
Dim Lastrow As Long
Dim SheetName As String
Dim Sex As String
Dim Country As String
Dim One As String
Dim Two As String
One = "Data" 'Modify name here if needed
Two = "Info" 'Modify name here if needed
Lastrow = Sheets(Two).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(One).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To Lastrow
SheetName = Sheets(Two).Cells(i, "A").Value
Country = Sheets(Two).Cells(i, "B").Value
Sex = Sheets(Two).Cells(i, "C").Value
Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
With Sheets(One).Range("A1:G" & Lastrowa)
If Len(Country) = "0" And Sex = Sex Then
.AutoFilter Field:=7, Criteria1:="*", Operator:=xlFilterValues
.AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
Else
If Len(Country) > 0 Then .AutoFilter Field:=7, Criteria1:=Country, Operator:=xlFilterValues
If Len(Sex) > 0 Then .AutoFilter Field:=5, Criteria1:=Sex, Operator:=xlFilterValues
End If
.SpecialCells(xlCellTypeVisible).Copy Worksheets(SheetName).Range("A1")
End With
Sheets(One).AutoFilterMode = False
Next
Sheets(One).AutoFilterMode = False
End Sub
 
Upvote 0
Wow, I see your big efforts here. You were right I cannot have anything hard coded (also because this is just a toy datasample, I will need to adapt this code to my real data). Your last code seems to work perfectly. I don't really understand why the previous one was working in that strange way but I'll try to study this.

Thank you so much!
 
Upvote 0
What a mess.This was a nice somewhat linear reference thread going for seven years and you hijacked it into a personal chat room with trial and error code.
 
Upvote 0
I had to reset Filter on Data sheet back to no filter after each country in sheet "info"
Wow, I see your big efforts here. You were right I cannot have anything hard coded (also because this is just a toy datasample, I will need to adapt this code to my real data). Your last code seems to work perfectly. I don't really understand why the previous one was working in that strange way but I'll try to study this.

Thank you so much!
 
Upvote 0
Kyotaki
Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.
 
Upvote 0
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.
 
Upvote 0
My first question would be. I believe you said you have modified the scipt I provided. So for me to make modifications to your modified script you would need to post here your modified script. Then I will see what I can do.
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.
 
Upvote 0

Forum statistics

Threads
1,217,390
Messages
6,136,319
Members
450,005
Latest member
BigPaws

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