Advanced Filter VBA Help

[Guest]

Hello,

Currently trying to copy data from one sheet to another. All data in column "J" is seperated and a new sheet is added for every unique value in column "J". Right now, only the values of the corresponding rows of "J" are copied, but I need the formulas and formatting to be copied as well. Can anyone give me a heads up on how to do this? Thanks so much



Sub ExtractReps()
ActiveSheet.Names.Add Name:="Database", RefersTo:="=$A$1:$AR$190"

Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("2005 OP")
Set rng = Range("Database")

Dim i As Integer


'extract a list of Sales Reps
ws1.Columns("J:J").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BL1"), Unique:=True
r = Cells(Rows.Count, "BL").End(xlUp).Row

'set up Criteria Area
If Range("J1").HasFormula = True Then
Range("J1").Formula.Copy Destination:=Range("BM1")
Else
Range("J1").Copy Destination:=Range("BM1")
End If

For Each c In Range("BL2:BL" & r)
'add the rep name to the criteria area
If ws1.Range("BM2").HasFormula Then
ws1.Range("BM2").Formula = c.Formula
Else
ws1.Range("BM2").Value = c.Value
End If
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("2005 OP").Range("BM1:BM2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False

For i = 1 To 4 And 6
Columns(i).Select
Selection.EntireColumn.Hidden = True
Next i

Next
ws1.Select
ws1.Columns("BL:BM").Delete

End Sub

 

[Don Guillett]

Here is an idea that may be of help

With Sheets("sourcesheet")
..Range("yourrange").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
..Range("yourrange").SpecialCells(xlCellTypeVisible).Copy
Sheets("destinationsheet").Range("b28").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
If .FilterMode = True Then .ShowAllData
' .Rows(4).Hidden = True
End With

--
Don Guillett
SalesAid Software
(e-mail address removed)
Hello,

Currently trying to copy data from one sheet to another. All data in column "J" is seperated and a new sheet is added for every unique value in column "J". Right now, only the values of the corresponding rows of "J" are copied, but I need the formulas and formatting to be copied as well. Can anyone give me a heads up on how to do this? Thanks so much



Sub ExtractReps()
ActiveSheet.Names.Add Name:="Database", RefersTo:="=$A$1:$AR$190"

Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("2005 OP")
Set rng = Range("Database")

Dim i As Integer


'extract a list of Sales Reps
ws1.Columns("J:J").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BL1"), Unique:=True
r = Cells(Rows.Count, "BL").End(xlUp).Row

'set up Criteria Area
If Range("J1").HasFormula = True Then
Range("J1").Formula.Copy Destination:=Range("BM1")
Else
Range("J1").Copy Destination:=Range("BM1")
End If

For Each c In Range("BL2:BL" & r)
'add the rep name to the criteria area
If ws1.Range("BM2").HasFormula Then
ws1.Range("BM2").Formula = c.Formula
Else
ws1.Range("BM2").Value = c.Value
End If
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("2005 OP").Range("BM1:BM2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False

For i = 1 To 4 And 6
Columns(i).Select
Selection.EntireColumn.Hidden = True
Next i

Next
ws1.Select
ws1.Columns("BL:BM").Delete

End Sub

 

[Debra Dalgleish]

The sample file here will copy the data with formulas:

http://www.contextures.com/excelfiles.html

Under Filters, look for 'Extract Items with Formulas'

It copies data to a new workbook, but you could modify that to copy to a
worksheet in the active workbook.

 

[vinnie]

Debra,

Is there not a way to copy the values as well as the formulas using
XlFilterCopy command inside the Advance Filter Method? The code you provided
seems to utilize a paste special method that I'm not familiar with. Thanks.

 

[Don Guillett]

What is your excel version?

 

[Debra Dalgleish]

If a table has been filtered, and you copy and paste the data, only the
values are pasted. That's why the sample workbook uses a different method.

The code adds a formula in column J, that returns TRUE or an empty
string. That column is copied, and pasted as values.

The line that may not be familiar is:

Set rng = Columns("J:J").SpecialCells(xlCellTypeConstants, 4)

It's equivalent to selecting column J, and choosing Edit>Go to
Click Special, and select Constants
Uncheck all except Logicals
Click OK
Cells that contain TRUE are selected.