Solved

Export Excel Filtered Results to new Workbook

Posted on 2011-02-28
6
550 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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
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

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

758 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now