filter macros

Microsoft Excel 2003 (full product)
July 4, 2010 at 05:08:16
Specs: windows xp
hi,
I just want a macro to help me out a job.

I have a set of names about 50 in file(say worksheet "list")
and each name has a separate excel in a single folder.
i need to open each excel corresponding to their names
and filter non blanks from a column and put it against each
name in worksheet: "list ".


See More: filter macros

Report •

#1
July 4, 2010 at 07:10:00
Hi,

As you haven't provided any specific information on where your data is in the various workbooks, or path names, I can only offer a generic approach - you will have to change addresses etc. to match your requirements.

This macro takes a list of filenames in Column A of the main workbook (your worksheet named 'list").
For each name it opens a workbook of the same name (followed by .xls - the macro adds the .xls).
On opening each workbook it filters data in column A of Worksheet "Sheet1", filtered for 'non-blanks'
It then copies the filtered cells
The copied cells are then transposed (column to row) and pasted alongside the original filename.

I suggest that you add the macro to a button on the worksheet containing the names.
Create a command button from the Control Toolbox toolbar.
(If this isn't visible, right click on an existing toolbar and check the Control Toolbox).
Select the button Icon and draw a button
Right-click the button and select Command Button - Edit and change the name to 'Get Data' or something suitable.
Right-click the button again and select View Code
In the code window that opens enter this:

Option Explicit

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strPath As String
Dim strFilename As String
Dim strFilePath As String
Dim rngSourceEnd As Range

'set path name for all files - include closing "\"
strPath = "C:\temp\"

'set start of list of names in Column A - heading on row 1
Set rngStart = Range("A2")
'find end of list of names in column A
Set rngEnd = Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through names in list
For Each rngCell In Range(rngStart, rngEnd)
    'create filename
    strFilename = rngCell.Text & ".xls"
    'create path/filename
    strFilePath = strPath & strFilename
    'open the file
    Workbooks.Open Filename:=strFilePath
    With Workbooks(strFilename)
        With .Worksheets("Sheet1")
            'filter on column A
            .Columns("A:A").AutoFilter Field:=1, Criteria1:="<>"
            'find end of data in column A
            Set rngSourceEnd = .Range("A" & CStr(Application.Rows.Count)) _
                            .End(xlUp)
            'copy data in column A
            .Range("A2:" & rngSourceEnd.Address) _
                        .SpecialCells(xlCellTypeVisible).Copy
        End With
        'paste data (transpose)
        rngCell.Offset(0, 1).PasteSpecial xlPasteAll, Transpose:=True
        'close file (dont save changes)
        .Close SaveChanges:=False
    End With
Next rngCell
End Sub

Note that Private Sub CommandButton1_Click() and End sub will already be present, so don't duplicate them. Option Explicit goes before Private Sub CommandButton1_Click().
Some lines of code have been split onto two lines for ease of viewing, using the line continuation character "_". This should work 'as is' just copy and paste, or you could remove the "_" and bring the code back to one line.

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.
Exit design mode (first icon on the Controls Toolbox toolbar).

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

Click the 'Get Data' button to run the macro

Note that all the named workbooks are closed after filter/copy but changes are not saved. This is 'by design' so that the workbooks do not open with a filter already in place.

Note also that re-running this macro will copy the changed/updated data - if there is less data than previous for any 'name' then the excess data will still be present on the relevant row.

If you use this macro, after changing it to match your data etc. please post it as a response and a data clear up can be proposed.

Regards


Report •

#2
July 4, 2010 at 18:03:53
Hi, thank you so much for the timely help.
this would really help in my task..

also i appreciate your comments in the coding...


Report •

#3
July 4, 2010 at 18:21:16

I have a series of data from coulumn A to Q in sheet 1.
and i need to filter some of the data and copy it to sheet 2 in
the same workbook.
i have given the manual steps which i would do , i need your
help in automating these steps.
The fist row in all columns has headings.


first part.

1.Aplly auto filter to all.

2.filter "CREL" from coulmun C

3.filter blanks from column G

4.filter non blanks from column F

5.filter "CHANGE" from column K

6.now i need to copy the contents from column B,F and Q to
sheet2 in column A,B,C.


second part.

1.filter >show all.

2.filter "CREL" from coulmun C

3.filter non blanks from column G and then H

4.filter "CHANGE" from column P

5.now i need to copy the contents from column B,O and Q to
sheet2 in column E,F,G.


THIRD PART

1.filter >show all.

2.filter 'CREL' from coulmun C

3.filter blanks from column F

4.filter "CHANGE" from column P

5.now i need to copy the contents from column B,O and Q to
sheet2 in column E,F,G i want append this to existing data
from second part.


Report •

Related Solutions

#4
July 5, 2010 at 00:15:44
Also can u modify the code u gave me in the first instance,
the change is in
'filter on column A
.Columns("A:A").AutoFilter Field:=1, Criteria1:="<>"

i need to go copy the data from the column whose heading says "SGID".
ie, in the coressponding excel against each name in "list",i need to copy all the data in the column whose heading says "SGID", then paste in the same way as before.


Report •

#5
July 5, 2010 at 05:59:58
Hi,

Here is a macro that does your "first part"
Note that to copy the cells it has to find the last row containing data. The code searches in column A for this last row.

If column A does not consistently contain data in all rows, either change the set end line to search another column, or hard code the row number, based on the last row ever used.

I don't know your data, so I have no idea whether your data never exceeds a particular row or whether it is constantly expanding - so I can't be sure which is the best approach.

    'find end of data in column A
    strRowEnd = CStr(.Range("A" & CStr(Application.Rows.Count)).End(xlUp).Row)

For a fixed last row, say 50 use this:

    strRowEnd = "50"

here is the macro:

Option Explicit

Private Sub CommandButton1_Click()
With Worksheets("Sheet1")
    'set start of data in column A
    strRowStart = "2"
    'find end of data in column A
    strRowEnd = CStr(.Range("A" & CStr(Application.Rows.Count)) _
                    .End(xlUp).Row)
    'select columns A to Q
    'apply filter to cols C,F,G & K (cols.3,6,7 & 11)
    With .Columns("A:Q")
        .AutoFilter Field:=3, Criteria1:="CREL"
        .AutoFilter Field:=6, Criteria1:="<>"
        .AutoFilter Field:=7, Criteria1:="="
        .AutoFilter Field:=11, Criteria1:="CHANGE"
    End With
    'copy visible cells in columns B, F & Q
    Range("B" & strRowStart & ":B" & strRowEnd & "," & _
          "F" & strRowStart & ":F" & strRowEnd & "," & _
          "Q" & strRowStart & ":Q" & strRowEnd) _
          .SpecialCells(xlCellTypeVisible).Copy
    'and paste to Sheet2 starting at Cell A2
    Worksheets("Sheet2").Range("A2").PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
    'clear autofilter
    .Columns("A:Q").AutoFilter
End With
End Sub

Note that I had this code attached to Button1, but as you may now have more than one button, the 'Sub' line will be different. If you select the button and use view code it will take you to the right place to paste it in.

You should be able to modify this code to do your second part.

The third part is slightly different as you want to append data, so you have to find where to start pasting the data.

I will look at the third part tomorrow.

Regards


Report •

#6
July 5, 2010 at 07:51:15
hey thanks for ur help again, could you help
me out in the response no.4.
i have a job based on your macro
tommorrow,it would be very nice of you, if
you could do the changes for me in your
code.

I will be waiting for your help..

Thanks and Regards
Ravana...


Report •

#7
July 5, 2010 at 12:40:06
Hi,

Regarding response number 4

Do you want to filter based on the data in a column labeled "SGID"
or do you want to filter on column A, but copy the filtered data from a column labeled "SGID"

Is the column labeled "SGID" always the same column - because having to find the column based on "SGID" in row 1 requires extra code.

Also are you copying the filtered data from column A and the column labeled "SGID".

Regards


Report •

#8
July 5, 2010 at 20:24:33
hi, i need to filter all, and "SGID" is not constant ,it keeps changing columns for each files.
SO i need to search SGID first and filter nonblanks and copy it in the coressponding excel against each name in "list",

Report •

#9
July 6, 2010 at 04:01:23
Hi,

Is the following correct:
Open an Excel file based on name in column A of worksheet "list" (Name plus ".xls")

In the named file that is opened, find a column with "SGID" in row 1

Autofilter the SGID row for all non-blank cells then select and copy the visible cells.

Paste with a transpose (column to row), on the row with the same name.

No other column in each opened (named) Excel file is used for a filter and no other column is copied/pasted.

Regards


Report •

#10
July 6, 2010 at 05:12:16
YA UR ABSOLUTEY RIGHT.

Report •

#11
July 6, 2010 at 05:27:10
Hi,

Also when searching SGID and IF IT Doesnt find anything means, the macro should proceed to the next name in the "list " file.

Regards
Ravana


Report •

#12
July 6, 2010 at 05:35:55
Hi,

Here is a modified macro that opens the named files as before, but instead of filtering on Column A, it filters on a column with "SGID" on row 1.
The filtered data is pasted as before.

In addition, the macro removes existing data on each row before pasting new data.
This ensures that if there is less new data than there was old data, some of the old data does not remain on the row.

Screen updating has been turned off to remove screen flicker

Change the path to your filies

Option Explicit

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strPath As String
Dim strFilename As String
Dim strFilePath As String
Dim rngSourceEnd As Range
Dim rngFind As Range

On Error GoTo ErrHnd

'stop screen updating to remove flicker
Application.ScreenUpdating = False

'set path name for all files - include closing "\"
strPath = "C:\temp\"

'set start of list of names in Column A - heading on row 1
Set rngStart = Range("A2")
'find end of list of names in column A
Set rngEnd = Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through names in list
For Each rngCell In Range(rngStart, rngEnd)
    'clean up any data on the row starting at column B
    'put something in column B for End to find in case there was no data
    rngCell.Offset(0, 1).Value = "B"
    Range("B" & rngCell.Row, _
                rngCell.Offset(0, CStr(Application.Columns.Count - 1)) _
                .End(xlToLeft).Address) _
                .Clear
    'create filename
    strFilename = rngCell.Text & ".xls"
    'create path/filename
    strFilePath = strPath & strFilename
    'open the file
    Workbooks.Open Filename:=strFilePath
    With Workbooks(strFilename)
        With .Worksheets("Sheet1")
            'find column with "SGID" in row 1
            Set rngFind = .Rows(1).Find("SGID")
            'find end of data in SGID column
            Set rngSourceEnd = rngFind.Offset(CStr(Application.Rows.Count) - 1, 0) _
                        .End(xlUp)
            'filter on SGID column
            rngFind.EntireColumn.AutoFilter Field:=1, Criteria1:="<>"
            'copy data in SGID column
            .Range(rngFind.Offset(1, 0).Address & ":" & rngSourceEnd.Address) _
                        .SpecialCells(xlCellTypeVisible).Copy
        End With
        'paste data (transpose)
        rngCell.Offset(0, 1).PasteSpecial xlPasteAll, Transpose:=True
        'remove filter
        rngFind.EntireColumn.AutoFilter
        'close file (dont save changes)
        .Close SaveChanges:=False
    End With
Next rngCell
'restore screen updating
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'restore screen updating
Application.ScreenUpdating = True
End Sub

As before, I have only tested this on limited sample data.
Test the macro on backup data and ensure that it works 'as expected'
Always make a backup before running the macro.

Regards
EDIT:
The above code was completed before seeing your additional requirement for files with no SGID column.


Report •

#13
July 6, 2010 at 06:20:28
Hi,

This appears to work when you have files with no "SGID" heading on row 1

The code is not very elegant - adding to existing code like this is not good.

Note that if a file previously had an SGID column, and now does not have an SGID row, the existing data will be removed from the row against that name.

Option Explicit

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim strPath As String
Dim strFilename As String
Dim strFilePath As String
Dim rngSourceEnd As Range
Dim rngFind As Range

On Error GoTo ErrHnd

'stop screen updating to remove flicker
Application.ScreenUpdating = False

'set path name for all files - include closing "\"
strPath = "C:\temp\"

'set start of list of names in Column A - heading on row 1
Set rngStart = Range("A2")
'find end of list of names in column A
Set rngEnd = Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through names in list
For Each rngCell In Range(rngStart, rngEnd)
    'clean up any data on the row starting at column B
    'put something in column B for End to find in case there was no data
    rngCell.Offset(0, 1).Value = "B"
    Range("B" & rngCell.Row, _
                rngCell.Offset(0, CStr(Application.Columns.Count - 1)) _
                .End(xlToLeft).Address) _
                .Clear
    'create filename
    strFilename = rngCell.Text & ".xls"
    'create path/filename
    strFilePath = strPath & strFilename
    'open the file
    Workbooks.Open Filename:=strFilePath
    With Workbooks(strFilename)
        With .Worksheets("Sheet1")
            'find column with "SGID" in row 1
            Set rngFind = .Rows(1).Find("SGID")
            'only do this if "SGID" found
            If Not rngFind Is Nothing Then
                'find end of data in SGID column
                Set rngSourceEnd = rngFind.Offset(CStr(Application.Rows.Count) - 1, 0) _
                            .End(xlUp)
                'filter on SGID column
                rngFind.EntireColumn.AutoFilter Field:=1, Criteria1:="<>"
                'copy data in SGID column
                .Range(rngFind.Offset(1, 0).Address & ":" & rngSourceEnd.Address) _
                            .SpecialCells(xlCellTypeVisible).Copy
            End If
        End With
        'only do this if "SGID" found
        If Not rngFind Is Nothing Then
            'paste data (transpose)
            rngCell.Offset(0, 1).PasteSpecial xlPasteAll, Transpose:=True
            'remove filter
            rngFind.EntireColumn.AutoFilter
        End If
        'close file (dont save changes)
        .Close SaveChanges:=False
    End With
Next rngCell
'restore screen updating
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'restore screen updating
Application.ScreenUpdating = True
End Sub

Regards

Report •

#14
July 6, 2010 at 17:11:55
Hi,

I appreciate you for spending time and resolving my quries,
thanks a lot for your help, this would greatly reduce my work.

Also learning from your works..


Thanks and Regards
Ram


Report •

#15
July 6, 2010 at 20:03:36
Hi Ram,

Thanks for your kind words.

I am glad to hear that you have a solution ... which I am sure you will continue to build on.

Regards

Humar


Report •

Ask Question