Solved

Export Excel Filtered Results to new Workbook

Posted on 2011-02-28
6
554 Views
Last Modified: 2012-05-11
Hello,

I have an excel file that I would like to filter the unique values of the "COLUMN_NAME" column to a new workbook.  What would be the best way to do this?  Please see the attached Excel File.

Thank you


Randy
Example.xls
0
Comment
Question by:rgutwein
  • 3
  • 2
6 Comments
 
LVL 6

Expert Comment

by:KnutsonBM
ID: 35000181
I would copy the entire column and past it into a new workbook, then do an advanced filter on that range and get just the unique values.

-Brandon
0
 
LVL 5

Author Comment

by:rgutwein
ID: 35000190
I also need the associated rows with those values in that column too.
0
 
LVL 6

Expert Comment

by:TinTombStone
ID: 35000774
This code worked on your example data, give it a go

Sub GetUniqueRows()
    Dim rng As Range, cnt As Integer, dataArr() As Variant
    Dim newBook As Workbook, thisBook As Workbook, fltRng As Range
    Application.ScreenUpdating = False
   
    Set thisBook = ActiveWorkbook
    Range("C1").Select
    thisBook.Worksheets("Sheet1").Sort.SortFields.Clear
    thisBook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Set rng = Range("A1").CurrentRegion.Resize(Range("A1").CurrentRegion.Rows.Count - 1, 9).Offset(1)
    With thisBook.Worksheets("Sheet1").Sort
        .SetRange rng
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    dataArr() = rng
   
    For cnt = 1 To UBound(dataArr()) - 1
   
        If dataArr(cnt, 3) = dataArr(cnt + 1, 3) Then
            rng.Rows(cnt + 1).Hidden = True
        End If
   
    Next
   
    Set fltRng = rng.SpecialCells(xlCellTypeVisible)
    Set newBook = Workbooks.Add
    fltRng.Copy newBook.Sheets("Sheet1").Range("A2")
    thisBook.Sheets("Sheet1").Range("A1:H1").Copy newBook.Sheets("Sheet1").Range("A1")
    newBook.Sheets("Sheet1").Columns("A:H").EntireColumn.AutoFit

    rng.Rows.Hidden = False
End Sub
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 5

Author Comment

by:rgutwein
ID: 35001216
Hey Guys,

Thank you so much for the quick responses.  I am not sure if I was clear enough with my original description.  But I need to be able to export the filter results into a separate excel file, not just a single unique row.   I would basically need the the following output:

*****Original File:******
DISTRICT_ID      TABLE_NAME      COLUMN_NAME      NEW_VALUE      ROW_ID      KEYID1      KEYID2      SIF1      SIF2
12345      STUDENT_SCHOOLS      UDF112      193                  17312      222555      
12345      STUDENT_SCHOOLS      UDF116      214                  17312      111222      
12345      STUDENT_SCHOOLS      UDF74      196                  17312      333555      
12345      STUDENT_SCHOOLS      UDF74      193                  17312      444666      

******Export:******

Workbook 1
DISTRICT_ID      TABLE_NAME      COLUMN_NAME      NEW_VALUE      ROW_ID      KEYID1      KEYID2      SIF1      SIF2
12345      STUDENT_SCHOOLS      UDF112      193                  17312      222555      


Workbook 2
DISTRICT_ID      TABLE_NAME      COLUMN_NAME      NEW_VALUE      ROW_ID      KEYID1      KEYID2      SIF1      SIF2
12345      STUDENT_SCHOOLS      UDF116      214                  17312      111222      

Workbook 3
DISTRICT_ID      TABLE_NAME      COLUMN_NAME      NEW_VALUE      ROW_ID      KEYID1      KEYID2      SIF1      SIF2
12345      STUDENT_SCHOOLS      UDF74      196                  17312      333555      
12345      STUDENT_SCHOOLS      UDF74      193                  17312      444666      
0
 
LVL 6

Accepted Solution

by:
TinTombStone earned 500 total points
ID: 35005399
OK then, try this.  Again it worked on the sample data you supplied

Sub GetUniqueRows()
    Dim rng As Range, cnt As Integer, dataArr() As Variant
    Dim newBook As Workbook, thisBook As Workbook, fltRng As Range
    Dim fltCrit As Range, LastRow As Long, shName As String
   
    Application.ScreenUpdating = False
   
    Set thisBook = ActiveWorkbook
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C1").Select
   
    thisBook.Worksheets("Sheet1").Sort.SortFields.Clear
    thisBook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Set rng = Range("A1").CurrentRegion.Resize(Range("A1").CurrentRegion.Rows.Count - 1, 9).Offset(1)
   
    With thisBook.Worksheets("Sheet1").Sort
        .SetRange rng
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A" & LastRow + 5), Unique:=True
    Range("A" & LastRow + 5).Select
   
   Set fltCrit = Range("A" & LastRow + 5).CurrentRegion
   Set rng = Range("A1").CurrentRegion
   For cnt = 2 To fltCrit.Rows.Count
        shName = fltCrit.Cells(cnt, 1).Value
        rng.AutoFilter 3, shName
        Set newBook = Workbooks.Add
        newBook.Sheets("Sheet1").Name = shName
        rng.SpecialCells(xlCellTypeVisible).Copy newBook.Sheets(shName).Range("A1")
        newBook.Sheets(shName).Columns("A:H").AutoFit
        thisBook.Activate
   Next cnt
   fltCrit.Clear
   rng.AutoFilter

End Sub
0
 
LVL 5

Author Closing Comment

by:rgutwein
ID: 35006832
Worked like a charm, thanks!
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

829 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question