selecting filtred range

[Guest]

Hello,

I'm using autofilter in my sheet. The sheet is filtred by many criteria and
has a header. Criteria are changed in loop.
After filtering I'd like to copy filtred data copy to another sheet(the same
sheet for all entries) but without the header.
I don't know how to recognize where data start. Some rows are alaways hiden
and "first" row under the header may sometimes be 16th row sometimes 5th row
etc.
And I don't want the header to copy together with filtred data
thanks in advance

JH

 

[Tom Ogilvy]

Set rng = ActiveSheet.Autofilter.Range
if rng.Columns(1).SpecialCells(xlVisible).Count > 1 then
rng.offset(1,0).Resize(rng.rows.count-1).Copy _
Destination:= Worksheets(2).Range("A1")
Else
msgbox "No visible data"
End If

 

[JulieD]

Hi JH

would a solution where the header was copied in with the filtered data and
then simply deleted do?
what is the destination sheet name & cell reference?

Cheers
JulieD

 

[Guest]

thank you Tom
that is exactly I needed

JH

Set rng = ActiveSheet.Autofilter.Range
if rng.Columns(1).SpecialCells(xlVisible).Count > 1 then
rng.offset(1,0).Resize(rng.rows.count-1).Copy _
Destination:= Worksheets(2).Range("A1")
Else
msgbox "No visible data"
End If

 

[Guest]

Tom,
I found this bit of code, but I'm getting an Error 91.
I tried Dim rng As Range, but still nogo.
Any suggestion?

 

[Dave Peterson]

What line do you get that error?

If it's the "Set rng = ActiveSheet.Autofilter.Range" line, then make sure that
the activesheet has Data|Filter|autofilter applied before you run the macro.

If it's not that line, post back with more info.

 

[Guest]

I see...no, the AutoFilter is NOT turned on...I'm using code to apply the
filter. Guess this won't work then.
Thanks anyway Dave!!

 

[Dave Peterson]

You can record a macro when you apply the filter and filter the way you want.

Then just add Tom's code to the bottom. It may even work!

 

[Guest]

I recorded it, got one line which I put at the front...no go. Here's what I
have:

Sub MoveData()
Dim rng As Range

Application.Run "'Payroll Combo.xls'!ApplyFilter" '<<< New Line
Set rng = ActiveSheet.AutoFilter.Range
If rng.Columns(1).SpecialCells(xlVisible).Count > 1 Then
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("sheet1").Range("A2")
Else
MsgBox "No visible data"
End If

End Sub

I'm trying some new code to try and do the same thing, but not getting any
results, although it seems to be working. Maybe this is a better alternative,
if I can get it to work:
Sub CopyData()

Dim lRow As Long 'Last Row
Dim nRow As Long 'Next Row to copy to
Dim cnt As Long

lRow = Sheets("All_Jobs").Range("A" & Sheets("All_Jobs").Rows.Count).End(xlUp)
With Sheets("All_Jobs")
For cnt = 7 To lRow '<<<Data starts on Row 7
If .Range("A" & cnt) = ("FilterCriteria") Then '<<FilterCriteria is the
named range of two cells with a start date - end date, without the headers. I
THINK THE PROBLEM IS HERE!!
nRow = Sheets("sheet1").Range("A" & _
Sheets("sheet1").Rows.Count).End(xlUp).Offset(1, 0).Row
.Range("A" & cnt).Copy Sheets("sheet1").Range("A" & nRow + 1) '<< I
need to start the paste on Row 2. Row 1 has headers.
End If
Next
End With


End Sub

 

[Dave Peterson]

Try recording it as you select the range
then Data|Filter|autofilter.

I have no idea what ApplyFilter in payroll combo.xls actually does.

And this line is gonna cause trouble

 

[Dave Peterson]

Try recording it as you select the range
then Data|Filter|autofilter.

I have no idea what ApplyFilter in payroll combo.xls actually does.

And this line is gonna cause trouble

If .Range("A" & cnt) = ("FilterCriteria")

If filterCriteria is a 2 celled range, comparing one cell to those two cells
won't work.

maybe...

if .range("a" & cnt).value _
= worksheets("somesheetname").range("FilterCriteria").cells(1).value then
....

 

[Guest]

I'm not using the AutoFilter...
Here is the code for Apply Filter... Sorry.

Option Explicit
Sub ApplyFilter()
Dim wsDL As Worksheet
Dim wsO As Worksheet
Dim rngAD As Range

Set wsDL = Sheets("DateList") '<<List of all valid dates
Set wsO = Sheets("All_Jobs")
Set rngAD = wsO.Range("AllDates")
'update the list of dates
wsDL.Range("A1").CurrentRegion.ClearContents
'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
rngAD.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=wsDL.Range("A1"), Unique:=True
wsDL.Range("A1").CurrentRegion.Sort _
Key1:=wsDL.Range("A2"), Order1:=xlAscending, Header:=xlYes
'filter the list
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=wsO.Range("H1:I2"), Unique:=False
Range("B4") = "Y"
End Sub

 

[Guest]

ARGGHHH!!!!
All I REALLY want is for THIS code to start at ROW 7..and then I don't need
the other stuff!!

PLEASE!!! See what you can do??

 

[Guest]

Well...it would help if you had the code...LOL!!
The data I'm looking at starts at Row 6 (6 is the header), with the filtered
data staring on 7 onward....I'm dying here!!

Option Explicit
Sub ExtractReps()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim wCtr As Long

Worksheets("sheet1").Visible = xlSheetVisible
Sheets("All_Jobs").Activate

Set ws1 = Sheets("All_Jobs")

Set rng = Range("DatabaseAll")
'Set rng = Range("Database")

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

'set up Criteria Area
Range("L1").Value = Range("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name to the criteria area
ws1.Range("L2").Value = c.Value

'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("All_Jobs").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set WSNew = Sheets.Add
WSNew.Move After:=Worksheets(Worksheets.Count)
WSNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("All_Jobs").Range("L1:L2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
End If

Next

 

[Dave Peterson]

Maybe starting with:

ws1.range("C6:C" & ws1.rows.count).Copy _
Destination:=Range("L1")

And make sure that DatabaseAll points at what you want.