• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 607
  • Last Modified:

Export Excel Filtered Results to new Workbook

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
rgutwein
Asked:
rgutwein
  • 3
  • 2
1 Solution
 
KnutsonBMCommented:
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
 
rgutweinAuthor Commented:
I also need the associated rows with those values in that column too.
0
 
TinTombStoneCommented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
rgutweinAuthor Commented:
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
 
TinTombStoneCommented:
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
 
rgutweinAuthor Commented:
Worked like a charm, thanks!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now