Extracting rows based on value in first row

[Guest]

I would like to create a macro that after the data is sorted and subtotaled,
it would go to a cell, for instance cost center, and all the cells and the
enitre rows that match that cost center be copied and added to a new
worksheet. I have created the macro to insert the new sheet and copy and
paste the data in the correct position by using the end up or down command,
but often the cells that are selected may include the wrong rows, especially
if there is only one cost center in that group. If I could write the macro
to recognize only the cost center number and select the cells based on that
number I believe all would work. I would like it to look at the first row of
the group after subtotalling and copy all the rows with that cost center.
Any help would be appreciated.

 

[Dave Peterson]

You may want to look at the way Ron de Bruin and Debra Dalgleish approached it:

Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb

 

[Bernie Deitrick]

Rob,

Try the macro below. Select a cell within your database, then run it, and when asked, reply with the
column number that contains your cost center. Note that it is the column number within the
database, not within the sheet (if your database is a block starting in H2, and column I is your
cost center, you would answer 2, not 9).

HTH,
Bernie
MS Excel MVP


Sub ExportDatabaseToSeparateSheets()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues

'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub