Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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).A utoFilter 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] |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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).A utoFilter 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] |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Auto-filtered data to new sheets
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Auto copy data rows between sheets depending on date entry | New Users to Excel | |||
Link to filtered Data - AUTO | Excel Discussion (Misc queries) | |||
Auto Updating Filtered Data on Next Sheet | Excel Discussion (Misc queries) | |||
Copy auto filtered data | Excel Discussion (Misc queries) | |||
Calculating auto filtered data | Excel Discussion (Misc queries) |