Am having trouble with following macros on line 51 (and likely beyond..). Can
someone assist? Getting R/T 424 Obj required error

Thank in advance,,

Sub AFDataToNewSheets()
Dim ws As Worksheet
Dim i As Integer
Dim curWks As Worksheet
Dim MyCell As Range
Dim NumRqdSheets As Integer
Dim RngF As Range
Dim ExistingFilterRng As Range
Dim FilterColumnWithState As Long

Application.DisplayAlerts = False ' Delete all existing sheets, except
Sheet1
For Each ws In Worksheets
If ws.Index > 1 Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Set curWks = Worksheets("sheet1")
FilterColumnWithState = 5 'column in the autofiltered data

With curWks
If .AutoFilterMode = False Then
MsgBox "Please apply Data|Filter|Autofilter"
Exit Sub
End If

Set ExistingFilterRng = .AutoFilter.Range

With ExistingFilterRng
.Columns(FilterColumnWithState).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
Set RngF = Nothing
On Error GoTo 0
Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
.Resize(.Rows.Count - 1).Cells _
.SpecialCells(xlCellTypeVisible)
NumRqdSheets = RngF.Rows.Count
On Error GoTo 0
End With

If RngF Is Nothing Then
'shouldn't happen
MsgBox "something bad happened"
Exit Sub
End If

For Each MyCell In RngF.Cells
With Worksheets
.Add(after:=.Item(.Count)).Name = MyCell.Text
End With
' ** Bomb Taking place on Next line **
ExistingFilterRng.Columns(FilterColumnWithState) _
.AutoFilter Field:=1, Criteria1:=MyCell.Value _
.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")
Next MyCell
.AutoFilterMode = False

ExistingFilterRng.AutoFilter
End With
Sheets("Sheet1").Activate
End Sub

This worked for me. I am not sure it is exactly what you are trying to do:

Sub AFDataToNewSheets()
Dim ws As Worksheet
Dim i As Integer
Dim curWks As Worksheet
Dim MyCell As Range
Dim NumRqdSheets As Integer
Dim RngF As Range
Dim ExistingFilterRng As Range
Dim FilterColumnWithState As Long

Application.DisplayAlerts = False ' Delete all existing sheets, except
Sheet1
For Each ws In Worksheets
If ws.Index > 1 Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Set curWks = Worksheets("sheet1")
FilterColumnWithState = 5 'column in the autofiltered data

With curWks
If .AutoFilterMode = False Then
MsgBox "Please apply Data|Filter|Autofilter"
Exit Sub
End If

Set ExistingFilterRng = .AutoFilter.Range

With ExistingFilterRng
.Columns(FilterColumnWithState).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
Set RngF = Nothing
On Error GoTo 0
Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
.Resize(.Rows.Count - 1).Cells _
.SpecialCells(xlCellTypeVisible)
NumRqdSheets = RngF.Rows.Count
On Error GoTo 0
End With
If RngF Is Nothing Then
'shouldn't happen
MsgBox "something bad happened"
Exit Sub
End If

For Each MyCell In RngF.Cells
If .FilterMode Then
.ShowAllData
End If
With Worksheets
Set sh = .Add(after:=.Item(.Count))
sh.Name = MyCell.Text
End With
' ** Bomb Taking place on Next line **
With ExistingFilterRng
.AutoFilter Field:=FilterColumnWithState, _
Criteria1:=MyCell.Value
.Parent.AutoFilter.Range.Copy
sh.Paste Destination:=Range("A1")
End With
Next MyCell

End With
Sheets("Sheet1").Activate
End Sub

--
Regards,
Tom Ogilvy


"JMay" wrote:

> Am having trouble with following macros on line 51 (and likely beyond..). Can
> someone assist? Getting R/T 424 Obj required error
>
> Thank in advance,,
>
> Sub AFDataToNewSheets()
> Dim ws As Worksheet
> Dim i As Integer
> Dim curWks As Worksheet
> Dim MyCell As Range
> Dim NumRqdSheets As Integer
> Dim RngF As Range
> Dim ExistingFilterRng As Range
> Dim FilterColumnWithState As Long
>
> Application.DisplayAlerts = False ' Delete all existing sheets, except
> Sheet1
> For Each ws In Worksheets
> If ws.Index > 1 Then
> ws.Delete
> End If
> Next ws
> Application.DisplayAlerts = True
> Set curWks = Worksheets("sheet1")
> FilterColumnWithState = 5 'column in the autofiltered data
>
> With curWks
> If .AutoFilterMode = False Then
> MsgBox "Please apply Data|Filter|Autofilter"
> Exit Sub
> End If
>
> Set ExistingFilterRng = .AutoFilter.Range
>
> With ExistingFilterRng
> .Columns(FilterColumnWithState).AdvancedFilter _
> Action:=xlFilterInPlace, Unique:=True
> Set RngF = Nothing
> On Error GoTo 0
> Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> .Resize(.Rows.Count - 1).Cells _
> .SpecialCells(xlCellTypeVisible)
> NumRqdSheets = RngF.Rows.Count
> On Error GoTo 0
> End With
>
> If RngF Is Nothing Then
> 'shouldn't happen
> MsgBox "something bad happened"
> Exit Sub
> End If
>
> For Each MyCell In RngF.Cells
> With Worksheets
> .Add(after:=.Item(.Count)).Name = MyCell.Text
> End With
> ' ** Bomb Taking place on Next line **
> ExistingFilterRng.Columns(FilterColumnWithState) _
> .AutoFilter Field:=1, Criteria1:=MyCell.Value _
> .SpecialCells(xlCellTypeVisible).Copy
> .Paste Destination:=Range("A1")
> Next MyCell
> .AutoFilterMode = False
>
> ExistingFilterRng.AutoFilter
> End With
> Sheets("Sheet1").Activate
> End Sub
>

Was this line:

' ** Bomb Taking place on Next line **
ExistingFilterRng.Columns(FilterColumnWithState) _
..AutoFilter Field:=1, Criteria1:=MyCell.Value _
..SpecialCells(xlCellTypeVisible).Copy
..Paste Destination:=Range("A1")

a tad long (with a line continuation line too many?) and maybe should be
something like:

ExistingFilterRng.Columns(FilterColumnWithState).AutoFilter Field:=1,
Criteria1:=MyCell.Value
ExistingFilterRng.SpecialCells(xlCellTypeVisible).Copy
.Paste Destination:=Range("A1")


depending on what you're trying to achieve.
--
p45cal


"JMay" wrote:

> Am having trouble with following macros on line 51 (and likely beyond..). Can
> someone assist? Getting R/T 424 Obj required error
>
> Thank in advance,,
[snip]

Thanks guys, I got it!!

"p45cal" wrote:

> Was this line:
>
> ' ** Bomb Taking place on Next line **
> ExistingFilterRng.Columns(FilterColumnWithState) _
> .AutoFilter Field:=1, Criteria1:=MyCell.Value _
> .SpecialCells(xlCellTypeVisible).Copy
> .Paste Destination:=Range("A1")
>
> a tad long (with a line continuation line too many?) and maybe should be
> something like:
>
> ExistingFilterRng.Columns(FilterColumnWithState).AutoFilter Field:=1,
> Criteria1:=MyCell.Value
> ExistingFilterRng.SpecialCells(xlCellTypeVisible).Copy
> .Paste Destination:=Range("A1")
>
>
> depending on what you're trying to achieve.
> --
> p45cal
>
>
> "JMay" wrote:
>
> > Am having trouble with following macros on line 51 (and likely beyond..). Can
> > someone assist? Getting R/T 424 Obj required error
> >
> > Thank in advance,,
> [snip]

Tom: What is this line doing (near end)..

..Parent.AutoFilter.Range.Copy

can't find answer googling
TIA,
Jim


"Tom Ogilvy" wrote:

> This worked for me. I am not sure it is exactly what you are trying to do:
>
> Sub AFDataToNewSheets()
> Dim ws As Worksheet
> Dim i As Integer
> Dim curWks As Worksheet
> Dim MyCell As Range
> Dim NumRqdSheets As Integer
> Dim RngF As Range
> Dim ExistingFilterRng As Range
> Dim FilterColumnWithState As Long
>
> Application.DisplayAlerts = False ' Delete all existing sheets, except
> Sheet1
> For Each ws In Worksheets
> If ws.Index > 1 Then
> ws.Delete
> End If
> Next ws
> Application.DisplayAlerts = True
> Set curWks = Worksheets("sheet1")
> FilterColumnWithState = 5 'column in the autofiltered data
>
> With curWks
> If .AutoFilterMode = False Then
> MsgBox "Please apply Data|Filter|Autofilter"
> Exit Sub
> End If
>
> Set ExistingFilterRng = .AutoFilter.Range
>
> With ExistingFilterRng
> .Columns(FilterColumnWithState).AdvancedFilter _
> Action:=xlFilterInPlace, Unique:=True
> Set RngF = Nothing
> On Error GoTo 0
> Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> .Resize(.Rows.Count - 1).Cells _
> .SpecialCells(xlCellTypeVisible)
> NumRqdSheets = RngF.Rows.Count
> On Error GoTo 0
> End With
> If RngF Is Nothing Then
> 'shouldn't happen
> MsgBox "something bad happened"
> Exit Sub
> End If
>
> For Each MyCell In RngF.Cells
> If .FilterMode Then
> .ShowAllData
> End If
> With Worksheets
> Set sh = .Add(after:=.Item(.Count))
> sh.Name = MyCell.Text
> End With
> ' ** Bomb Taking place on Next line **
> With ExistingFilterRng
> .AutoFilter Field:=FilterColumnWithState, _
> Criteria1:=MyCell.Value
> .Parent.AutoFilter.Range.Copy
> sh.Paste Destination:=Range("A1")
> End With
> Next MyCell
>
> End With
> Sheets("Sheet1").Activate
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
> "JMay" wrote:
>
> > Am having trouble with following macros on line 51 (and likely beyond..). Can
> > someone assist? Getting R/T 424 Obj required error
> >
> > Thank in advance,,
> >
> > Sub AFDataToNewSheets()
> > Dim ws As Worksheet
> > Dim i As Integer
> > Dim curWks As Worksheet
> > Dim MyCell As Range
> > Dim NumRqdSheets As Integer
> > Dim RngF As Range
> > Dim ExistingFilterRng As Range
> > Dim FilterColumnWithState As Long
> >
> > Application.DisplayAlerts = False ' Delete all existing sheets, except
> > Sheet1
> > For Each ws In Worksheets
> > If ws.Index > 1 Then
> > ws.Delete
> > End If
> > Next ws
> > Application.DisplayAlerts = True
> > Set curWks = Worksheets("sheet1")
> > FilterColumnWithState = 5 'column in the autofiltered data
> >
> > With curWks
> > If .AutoFilterMode = False Then
> > MsgBox "Please apply Data|Filter|Autofilter"
> > Exit Sub
> > End If
> >
> > Set ExistingFilterRng = .AutoFilter.Range
> >
> > With ExistingFilterRng
> > .Columns(FilterColumnWithState).AdvancedFilter _
> > Action:=xlFilterInPlace, Unique:=True
> > Set RngF = Nothing
> > On Error GoTo 0
> > Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> > .Resize(.Rows.Count - 1).Cells _
> > .SpecialCells(xlCellTypeVisible)
> > NumRqdSheets = RngF.Rows.Count
> > On Error GoTo 0
> > End With
> >
> > If RngF Is Nothing Then
> > 'shouldn't happen
> > MsgBox "something bad happened"
> > Exit Sub
> > End If
> >
> > For Each MyCell In RngF.Cells
> > With Worksheets
> > .Add(after:=.Item(.Count)).Name = MyCell.Text
> > End With
> > ' ** Bomb Taking place on Next line **
> > ExistingFilterRng.Columns(FilterColumnWithState) _
> > .AutoFilter Field:=1, Criteria1:=MyCell.Value _
> > .SpecialCells(xlCellTypeVisible).Copy
> > .Paste Destination:=Range("A1")
> > Next MyCell
> > .AutoFilterMode = False
> >
> > ExistingFilterRng.AutoFilter
> > End With
> > Sheets("Sheet1").Activate
> > End Sub
> >

Your code looks like this:

> With ExistingFilterRng
> .AutoFilter Field:=FilterColumnWithState, _
> Criteria1:=MyCell.Value
> .Parent.AutoFilter.Range.Copy

which is essentially this line (for the .copy)

ExistingFilterRng.Parent.AutoFilter.Range.Copy

The parent of the range is the worksheet that owns the range. So you're copying
the autofilter range from the same worksheet that owns the existingfilterrng
(same as curwks or Sheet1 in your code).



JMay wrote:
>
> Tom: What is this line doing (near end)..
>
> .Parent.AutoFilter.Range.Copy
>
> can't find answer googling
> TIA,
> Jim
>
> "Tom Ogilvy" wrote:
>
> > This worked for me. I am not sure it is exactly what you are trying to do:
> >
> > Sub AFDataToNewSheets()
> > Dim ws As Worksheet
> > Dim i As Integer
> > Dim curWks As Worksheet
> > Dim MyCell As Range
> > Dim NumRqdSheets As Integer
> > Dim RngF As Range
> > Dim ExistingFilterRng As Range
> > Dim FilterColumnWithState As Long
> >
> > Application.DisplayAlerts = False ' Delete all existing sheets, except
> > Sheet1
> > For Each ws In Worksheets
> > If ws.Index > 1 Then
> > ws.Delete
> > End If
> > Next ws
> > Application.DisplayAlerts = True
> > Set curWks = Worksheets("sheet1")
> > FilterColumnWithState = 5 'column in the autofiltered data
> >
> > With curWks
> > If .AutoFilterMode = False Then
> > MsgBox "Please apply Data|Filter|Autofilter"
> > Exit Sub
> > End If
> >
> > Set ExistingFilterRng = .AutoFilter.Range
> >
> > With ExistingFilterRng
> > .Columns(FilterColumnWithState).AdvancedFilter _
> > Action:=xlFilterInPlace, Unique:=True
> > Set RngF = Nothing
> > On Error GoTo 0
> > Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> > .Resize(.Rows.Count - 1).Cells _
> > .SpecialCells(xlCellTypeVisible)
> > NumRqdSheets = RngF.Rows.Count
> > On Error GoTo 0
> > End With
> > If RngF Is Nothing Then
> > 'shouldn't happen
> > MsgBox "something bad happened"
> > Exit Sub
> > End If
> >
> > For Each MyCell In RngF.Cells
> > If .FilterMode Then
> > .ShowAllData
> > End If
> > With Worksheets
> > Set sh = .Add(after:=.Item(.Count))
> > sh.Name = MyCell.Text
> > End With
> > ' ** Bomb Taking place on Next line **
> > With ExistingFilterRng
> > .AutoFilter Field:=FilterColumnWithState, _
> > Criteria1:=MyCell.Value
> > .Parent.AutoFilter.Range.Copy
> > sh.Paste Destination:=Range("A1")
> > End With
> > Next MyCell
> >
> > End With
> > Sheets("Sheet1").Activate
> > End Sub
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> > "JMay" wrote:
> >
> > > Am having trouble with following macros on line 51 (and likely beyond..). Can
> > > someone assist? Getting R/T 424 Obj required error
> > >
> > > Thank in advance,,
> > >
> > > Sub AFDataToNewSheets()
> > > Dim ws As Worksheet
> > > Dim i As Integer
> > > Dim curWks As Worksheet
> > > Dim MyCell As Range
> > > Dim NumRqdSheets As Integer
> > > Dim RngF As Range
> > > Dim ExistingFilterRng As Range
> > > Dim FilterColumnWithState As Long
> > >
> > > Application.DisplayAlerts = False ' Delete all existing sheets, except
> > > Sheet1
> > > For Each ws In Worksheets
> > > If ws.Index > 1 Then
> > > ws.Delete
> > > End If
> > > Next ws
> > > Application.DisplayAlerts = True
> > > Set curWks = Worksheets("sheet1")
> > > FilterColumnWithState = 5 'column in the autofiltered data
> > >
> > > With curWks
> > > If .AutoFilterMode = False Then
> > > MsgBox "Please apply Data|Filter|Autofilter"
> > > Exit Sub
> > > End If
> > >
> > > Set ExistingFilterRng = .AutoFilter.Range
> > >
> > > With ExistingFilterRng
> > > .Columns(FilterColumnWithState).AdvancedFilter _
> > > Action:=xlFilterInPlace, Unique:=True
> > > Set RngF = Nothing
> > > On Error GoTo 0
> > > Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> > > .Resize(.Rows.Count - 1).Cells _
> > > .SpecialCells(xlCellTypeVisible)
> > > NumRqdSheets = RngF.Rows.Count
> > > On Error GoTo 0
> > > End With
> > >
> > > If RngF Is Nothing Then
> > > 'shouldn't happen
> > > MsgBox "something bad happened"
> > > Exit Sub
> > > End If
> > >
> > > For Each MyCell In RngF.Cells
> > > With Worksheets
> > > .Add(after:=.Item(.Count)).Name = MyCell.Text
> > > End With
> > > ' ** Bomb Taking place on Next line **
> > > ExistingFilterRng.Columns(FilterColumnWithState) _
> > > .AutoFilter Field:=1, Criteria1:=MyCell.Value _
> > > .SpecialCells(xlCellTypeVisible).Copy
> > > .Paste Destination:=Range("A1")
> > > Next MyCell
> > > .AutoFilterMode = False
> > >
> > > ExistingFilterRng.AutoFilter
> > > End With
> > > Sheets("Sheet1").Activate
> > > End Sub
> > >

--

Dave Peterson

I was thinking it was something like you said..
BUT YOU NAILED IT !!
Tks Dave
Jim

"Dave Peterson" wrote:

> Your code looks like this:
>
> > With ExistingFilterRng
> > .AutoFilter Field:=FilterColumnWithState, _
> > Criteria1:=MyCell.Value
> > .Parent.AutoFilter.Range.Copy
>
> which is essentially this line (for the .copy)
>
> ExistingFilterRng.Parent.AutoFilter.Range.Copy
>
> The parent of the range is the worksheet that owns the range. So you're copying
> the autofilter range from the same worksheet that owns the existingfilterrng
> (same as curwks or Sheet1 in your code).
>
>
>
> JMay wrote:
> >
> > Tom: What is this line doing (near end)..
> >
> > .Parent.AutoFilter.Range.Copy
> >
> > can't find answer googling
> > TIA,
> > Jim
> >
> > "Tom Ogilvy" wrote:
> >
> > > This worked for me. I am not sure it is exactly what you are trying to do:
> > >
> > > Sub AFDataToNewSheets()
> > > Dim ws As Worksheet
> > > Dim i As Integer
> > > Dim curWks As Worksheet
> > > Dim MyCell As Range
> > > Dim NumRqdSheets As Integer
> > > Dim RngF As Range
> > > Dim ExistingFilterRng As Range
> > > Dim FilterColumnWithState As Long
> > >
> > > Application.DisplayAlerts = False ' Delete all existing sheets, except
> > > Sheet1
> > > For Each ws In Worksheets
> > > If ws.Index > 1 Then
> > > ws.Delete
> > > End If
> > > Next ws
> > > Application.DisplayAlerts = True
> > > Set curWks = Worksheets("sheet1")
> > > FilterColumnWithState = 5 'column in the autofiltered data
> > >
> > > With curWks
> > > If .AutoFilterMode = False Then
> > > MsgBox "Please apply Data|Filter|Autofilter"
> > > Exit Sub
> > > End If
> > >
> > > Set ExistingFilterRng = .AutoFilter.Range
> > >
> > > With ExistingFilterRng
> > > .Columns(FilterColumnWithState).AdvancedFilter _
> > > Action:=xlFilterInPlace, Unique:=True
> > > Set RngF = Nothing
> > > On Error GoTo 0
> > > Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> > > .Resize(.Rows.Count - 1).Cells _
> > > .SpecialCells(xlCellTypeVisible)
> > > NumRqdSheets = RngF.Rows.Count
> > > On Error GoTo 0
> > > End With
> > > If RngF Is Nothing Then
> > > 'shouldn't happen
> > > MsgBox "something bad happened"
> > > Exit Sub
> > > End If
> > >
> > > For Each MyCell In RngF.Cells
> > > If .FilterMode Then
> > > .ShowAllData
> > > End If
> > > With Worksheets
> > > Set sh = .Add(after:=.Item(.Count))
> > > sh.Name = MyCell.Text
> > > End With
> > > ' ** Bomb Taking place on Next line **
> > > With ExistingFilterRng
> > > .AutoFilter Field:=FilterColumnWithState, _
> > > Criteria1:=MyCell.Value
> > > .Parent.AutoFilter.Range.Copy
> > > sh.Paste Destination:=Range("A1")
> > > End With
> > > Next MyCell
> > >
> > > End With
> > > Sheets("Sheet1").Activate
> > > End Sub
> > >
> > > --
> > > Regards,
> > > Tom Ogilvy
> > >
> > >
> > > "JMay" wrote:
> > >
> > > > Am having trouble with following macros on line 51 (and likely beyond..). Can
> > > > someone assist? Getting R/T 424 Obj required error
> > > >
> > > > Thank in advance,,
> > > >
> > > > Sub AFDataToNewSheets()
> > > > Dim ws As Worksheet
> > > > Dim i As Integer
> > > > Dim curWks As Worksheet
> > > > Dim MyCell As Range
> > > > Dim NumRqdSheets As Integer
> > > > Dim RngF As Range
> > > > Dim ExistingFilterRng As Range
> > > > Dim FilterColumnWithState As Long
> > > >
> > > > Application.DisplayAlerts = False ' Delete all existing sheets, except
> > > > Sheet1
> > > > For Each ws In Worksheets
> > > > If ws.Index > 1 Then
> > > > ws.Delete
> > > > End If
> > > > Next ws
> > > > Application.DisplayAlerts = True
> > > > Set curWks = Worksheets("sheet1")
> > > > FilterColumnWithState = 5 'column in the autofiltered data
> > > >
> > > > With curWks
> > > > If .AutoFilterMode = False Then
> > > > MsgBox "Please apply Data|Filter|Autofilter"
> > > > Exit Sub
> > > > End If
> > > >
> > > > Set ExistingFilterRng = .AutoFilter.Range
> > > >
> > > > With ExistingFilterRng
> > > > .Columns(FilterColumnWithState).AdvancedFilter _
> > > > Action:=xlFilterInPlace, Unique:=True
> > > > Set RngF = Nothing
> > > > On Error GoTo 0
> > > > Set RngF = .Columns(FilterColumnWithState).Offset(1, 0) _
> > > > .Resize(.Rows.Count - 1).Cells _
> > > > .SpecialCells(xlCellTypeVisible)
> > > > NumRqdSheets = RngF.Rows.Count
> > > > On Error GoTo 0
> > > > End With
> > > >
> > > > If RngF Is Nothing Then
> > > > 'shouldn't happen
> > > > MsgBox "something bad happened"
> > > > Exit Sub
> > > > End If
> > > >
> > > > For Each MyCell In RngF.Cells
> > > > With Worksheets
> > > > .Add(after:=.Item(.Count)).Name = MyCell.Text
> > > > End With
> > > > ' ** Bomb Taking place on Next line **
> > > > ExistingFilterRng.Columns(FilterColumnWithState) _
> > > > .AutoFilter Field:=1, Criteria1:=MyCell.Value _
> > > > .SpecialCells(xlCellTypeVisible).Copy
> > > > .Paste Destination:=Range("A1")
> > > > Next MyCell
> > > > .AutoFilterMode = False
> > > >
> > > > ExistingFilterRng.AutoFilter
> > > > End With
> > > > Sheets("Sheet1").Activate
> > > > End Sub
> > > >
>
> --
>
> Dave Peterson
>