Filter and copy

Angela · Jul 9th 2005

Dear Excel Helpers,

I have a big workbook with six sheets each sheet contains about 10 columns of data. There is one column that contains US state abbreviations (AL, CA.FL,GA,MA, etc.). I am attaching a sample of my big file with only three sheets that contains partial data for only four states and fewer columns of other data. What I want to do is the following;

1. Filter the data in each sheet in the original workbook for a specific state (say, CA0 anf copy the filtered data in sepatate sheets in a new workbook.
2. The end result would be a new file with three sheets containing the filtered data for CA.
3.The sheet names in the new workbook should correspond to the sheet names in the original workbook.
4. I would like preferably , a drop down box created with the State names so that the user can choose the state from the list.to get the filtered data for that state.

I tried to work on the above problem myself, but after spending a lot of time I am finding that I am not getting to do what I want to get done.

Please can someone help me with a macro?

Thank a lot.

Angela.

Angela · Jul 9th 2005

Re: Filter and copy

Dear All,

Can someone help with a solution to my post, please?

Thank you all,

Angela

Angela · Jul 9th 2005

Re: Filter and copy

Hi All,
I have worked on this problem on my own and have progressed quite a bit. What I am able to do is the sort all the worksheets and then filter the sheets for field:= 2 and Criteria1:= “CA”. I have created a validation list called “Select a State” to choose one of the states that I want to filter data (“CA”) in a sheet named “State”. I want to Have in the Criteria1:= to read from the validation list and not entered manually. Can someone help me with this problem? I need to give this to someone on Monday and would appreciate all help. Thanks.

Angela

Code

Option Explicit


Sub ToSortTest()
Dim Sht As Worksheet
Dim sCurrentSheet As String
 Dim lstRow As Long
On Error Resume Next
sCurrentSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False


For Each Sht In Application.Worksheets
If Not Sht.Name = "State" Then Sht.Activate


    lstRow = Range("A65536").End(xlUp).Row
    
    Range("A4:G" & lstRow).Select
       
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Next Sht
Application.EnableEvents = True
 Application.DisplayAlerts = True
End Sub
Sub ToFilterTest()
Dim Sht As Worksheet
Dim sCurrentSheet As String
 Dim lstRow As Long
On Error Resume Next
sCurrentSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False


For Each Sht In Application.Worksheets
If Not Sht.Name = "State" Then Sht.Activate
 
  lstRow = Range("A65536").End(xlUp).Row
    
    Range("A2:G" & lstRow).Select
    
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="CA"
   
Next Sht
Application.EnableEvents = True
 Application.DisplayAlerts = True
End Sub

Display More

Maqbool · Jul 10th 2005

Re: Filter and copy

Hi Angel a:

I hope the following code will do what you are after.

Code

Sub FltrToNewWb()


Application.ScreenUpdating = False
Application.DisplayAlerts = False


On Error Resume Next


Dim wbData As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim rngCrit As String




Set wbData = Workbooks("Test 1.xls")
Set wbNew = Workbooks.Add  ' creat new file
wbNew.SaveAs "NewFile.xls" ' save the new file
Set wbNew = Workbooks("NewFile.xls")


rngCrit = wbData.Sheets(1).Range("C3") 'filter criteria




x = 2 'Start filtering from second sheet, since I moved your sht "State" to first
i = wbData.Sheets.Count ' total number of sheets to filter
For Each ws In wbData.Sheets
    If x > i Then Exit For
    Set ws = wbData.Sheets(x)
    With ws.Range("A2")
        .AutoFilter 2, rngCrit
        k = Application.WorksheetFunction.Subtotal(3, .Range("A2").CurrentRegion)
        If k > 5 Then  'check for data after filter, if there is data then copy
            ws.Range("A2", .Range("A2").End(xlDown).Offset(0, 3)).Copy
        End If
        
        With wbNew.Sheets(x - 1)
             .Range("A2").PasteSpecial xlValues   'Pastes it in the new wb
             Application.CutCopyMode = False
             If .Name <> ws.Name Then .Name = ws.Name  ' change sheet name in new wb
        End With
             
    End With
        
    ws.AutoFilterMode = False
    x = x + 1
Next


Application.ScreenUpdating = True
Application.DisplayAlerts = True




End Sub

Display More

Regards

Maqbool

Angela · Jul 10th 2005

Re: Filter and copy

Maqbool,

Thank you so very much for getting back to me with a great macro for my “filter copy” problem. It is working very well with the sample data I sent to you. But the original file I have is much bigger and I am not able to modify the codes to get that file working. Here are the things that need to be changed.
1. The original data has 7 sheets data instead of 3 in the sample set.
2. There are data up to Column S in the original data (total number of columns of data=19)
3. The number of rows in each sheet can be above 5000.
4. The State variable is in column 7 in the original data set.

I tried to modify the codes to work on the original file but could not do it on my own and need your help. I cannot reveal the original data but I am attaching sample layout of the original data so that it will help you to modify the codes.

Maqbool, once again thank you so very much for a great macro and I will be very happy if you could get the modified version of the macro as soon as you can.

Regards,

Angela

rbrhodes · Jul 11th 2005

Re: Filter and copy

Hi Angela,

My day off so I played with Maqbools' code and your example sheet.

The main changes I made are:

- Added a button from the Controls Toolbox to run the macro

- InputBox asks for filename to 'Save As'

- Checks what to copy based on Column G (State) as Col A could have blanks

- Adds sheets to new workbook if required

- Saves workbook when macro completes

- Comments, comments, comments...

Cheers,

dr

Angela · Jul 11th 2005

Re: Filter and copy

rbrhodes,

This is great and thank you so very much for the changes you made to Maqbool's macro. It is about 11.00 PM now in the US and I can sleep well tonight. I still have to use the macro on my original file which I mentioned earlier has 7 sheets and more than 5000 variable roes in each sheet. For one thing more I need you help, if you can. The new workbook should be formatted in the same way as the first workbook. I do not want to add any codes and screw up the working macro.

Tomorrow at work I will try the macro on my original file and get back to you. Meanwhile, thank you and Maqbool so very much for your time and effort. This is a great forum indeed!

Regards,

Angela

rbrhodes · Jul 11th 2005

Re: Filter and copy

Hi Angela,

I hope you get this before you go to work!

_Always_ try out code on a COPY of your file!

Cheers,

dr

Angela · Jul 11th 2005

Re: Filter and copy

rbrhodes,

The code works perfectly on my original file and pretty fast also. Thank you so very much. You have written a lot of comments along with the codes and that is very very useful. I will get back to you if I have any problem with this file.

Thank you,

Regards,

Angela

Angela · Jul 11th 2005

Re: Filter and copy

Hi All,

Rbrhodes gave me a great macro that works perfectly on my original file. But this morning I learnt that the original file should be split into 2 files as follows:

1.File I will have 3 of the original sheets with 3 summary sheets inserted in between the sheets. The summary sheets are named (1) Oct 05 Analysis, (2) Nov 05 Analysis, (3) Dec 05 Analyis
2.File 2 will have 4 original sheets with 4 summary sheets inserted in between the sheets.
I would like help in modifying the code so as not to include the 3 summary sheets also along with the sheet named “State” and auto filter only the remaining sheets.

I have given the codes where the changes needs to be made

Code

For Each ws In wbData.Sheets
'Check sheet is not "State"
        If ws.Name = "State" Then GoTo nextone
            With ws.Range("A2")
                .AutoFilter 7, rngCrit
                k = Application.WorksheetFunction.Subtotal(3, .Range("A2").CurrentRegion)
                If k <> 0 Then 'there is data
                If j < y Then wbNew.Sheets.Add after:=wbNew.Worksheets(Sheets.Count)
                    k = ws.Range("g65536").End(xlUp).Row
                    ws.Range("A1:S" & k).Copy
                    With wbNew.Sheets(y)
                        .Range("A1").PasteSpecial xlValues
                        Application.CutCopyMode = False
                        If .Name <> ws.Name Then .Name = ws.Name
                    End With
                    y = y + 1
                End If
            End With
        ws.AutoFilterMode = False
'Do next sheet
nextone:
    Next

Display More

Thank you all,

Angela

Angela · Jul 11th 2005

Re: Filter and copy

Hi All,

I would like to state my question again more clearly here. Suppose I have a workbook woth 9 sheets, For exaomle, let the sheet names by
New,S1,Sum1,S2,Sum2,S3,Sum3,S4,Sum4. How would I modicy the following code to ask to filter only the sheets S1, S2, S3 and S4 and leave the others?

For Each ws In wbData.Sheets
'Check sheet is not "New"
If ws.Name = "New" Then Goto nextone
'AutoFilter codes here
nextone:
Next

This is one part of the code that I have to complete in otherwise the big macro I am able to use that was written by rbrhodes.

Thank you all,

Angela

Maqbool · Jul 13th 2005

Re: Filter and copy

Hi Angela:

Try to change your as follows:

Code

For Each ws In wbData.Sheets
'Check sheet name are like S1,S2,S3 etc...
        If ws.Name = "S1" Or ws.Name = "S2" Or ws.Name = "S3" Then
           With ws.Range("A2")
                .AutoFilter 7, rngCrit
                k = Application.WorksheetFunction.Subtotal(3, .Range("A2").CurrentRegion)
                If k <> 0 Then 'there is data
                If j < y Then wbNew.Sheets.Add after:=wbNew.Worksheets(Sheets.Count)
                    k = ws.Range("g65536").End(xlUp).Row
                    ws.Range("A1:S" & k).Copy


                    With wbNew.Sheets(y)


                        .Range("A1").PasteSpecial xlValues
                        Application.CutCopyMode = False


                        If .Name <> ws.Name Then .Name = ws.Name
                    End With
                    
                End If
            End With
         y = y + 1
 
        End If
       
        ws.AutoFilterMode = False




    Next
     


    Workbooks(fName & ".xls").Save
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub

Display More

Regards

Maqbool

Angela · Jul 13th 2005

Re: Filter and copy

Maqbool,

It worked! Thank you very very much for all help.

Regards,

Angela

elric1958 · Oct 27th 2010

Re: Filter and copy

rbrhodes. #6 A beautiful macro and almost exactly what I need for a project of mine aswell. As a newb to vba, could you give me some clues how this macro could be modified so that the macro loops through the state values in Angela's data and saves a workbook for each state's value automatically. This is my first post on a forum so apologies if I am using the wrong etiquette.

Rob Xaos · Oct 27th 2010

Re: Filter and copy

Elric,

Ozgrid posting rules are one question (or close follow-ups) by the Original Poster only per thread. Please start your own thread and link back to a previous one if necessary.

Thank you.

rbrhodes · Oct 27th 2010

Re: Filter and copy

Hi,

Welcone to OzGrid !

but...

You will be busted by a mod for posting to an old thread and not starting a new one and linking to this one. C'est la vie.

dbl post ... twitchy finger... <grin>

Post again or click my sig

double post...ahh S happens

Filter and copy

Participate now!

Share