View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
CLR CLR is offline
external usenet poster
 
Posts: 1,998
Default Copy Autofilter results macro

Indeed that was the case Bob...........thanks for the response and the code,
I'll put it in my "special stash for neat stuff" place........

Vaya con Dios,
Chuck, CABGx3





"Bob Phillips" wrote:

Sounds like you don't have a filter on at all Chuck. You could test that

Sub CopyFilterInquiry()
Dim rng As Range
Dim rng2 As Range

Sheets("DATAINPUT").Select
If Not ActiveSheet.AutoFilterMode Then
MsgBox "No autofilter set"
Else
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1,
1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Inquiry").[DataRangeInquiry].Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy
Destination:=Worksheets("Inquiry").Range("A9")
End If
Sheets("Inquiry").Select
Range("a9").Select
End If
End Sub

--
HTH

Bob Phillips

"CLR" wrote in message
...
Thanks for the response Ron, but that is the exact code I'm

using......just
modified for my circumstance.

Vaya con Dios,
Chuck, CABGx3



"Ron de Bruin" wrote:

Hi CLR

See this example that use
If rng2 Is Nothing Then

http://www.contextures.com/xlautofilter03.html#Copy


--
Regards Ron de Bruin
http://www.rondebruin.nl



"CLR" wrote in message

...
Hi All.......

I have a macro obtained long ago from this group......I keep re-using

it
with modifications on new projects. It now works fine it there is any
results in the Autofilter, it fails when there is not, on line that

reads,
"With ActiveSheet.AutoFilter.Range".......it seems to me that it

worked when
I first got it, (maybe not, I almost never have no results on the

autofilter)
probably I've "enhanced" it to death........help please?


Sub CopyFilterInquiry()

Dim rng As Range
Dim rng2 As Range
Sheets("DATAINPUT").Select
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1,
1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Inquiry").[DataRangeInquiry].Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy
Destination:=Worksheets("Inquiry").Range("A9")
End If
Sheets("Inquiry").Select
Range("a9").Select

End Sub


TIA
Vaya con Dios,
Chuck, CABGx3