ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   selecting filtred range (https://www.excelbanter.com/excel-programming/372061-re-selecting-filtred-range.html)

David

selecting filtred range
 
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?

"Tom Ogilvy" wrote:

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

--
Regards,
Tom Ogilvy

"JH" wrote in message
...
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






Dave Peterson

selecting filtred range
 
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.

David wrote:

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?

"Tom Ogilvy" wrote:

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

--
Regards,
Tom Ogilvy

"JH" wrote in message
...
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






--

Dave Peterson

David

selecting filtred range
 
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" wrote:

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.

David wrote:

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?

"Tom Ogilvy" wrote:

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

--
Regards,
Tom Ogilvy

"JH" wrote in message
...
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






--

Dave Peterson


Dave Peterson

selecting filtred range
 
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!

David wrote:

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" wrote:

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.

David wrote:

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?

"Tom Ogilvy" wrote:

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

--
Regards,
Tom Ogilvy

"JH" wrote in message
...
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






--

Dave Peterson


--

Dave Peterson

David

selecting filtred range
 
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

selecting filtred range
 
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


David wrote:

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

Dave Peterson

selecting filtred range
 
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
....



David wrote:

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

David

selecting filtred range
 
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

"Dave Peterson" wrote:

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


David wrote:

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


David

selecting filtred range
 
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??

"Dave Peterson" wrote:

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


David wrote:

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


David

selecting filtred range
 
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" wrote:

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


David wrote:

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


Dave Peterson

selecting filtred range
 
Maybe starting with:

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

And make sure that DatabaseAll points at what you want.

David wrote:

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" wrote:

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


David wrote:

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


--

Dave Peterson


All times are GMT +1. The time now is 12:40 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com