Copy after Autofilter with no rows found

[Guest]

I've run into a quirky situation. I have a row of labels and then my data
below that. I'm using Autofilter to select rows below the labels meeting
certain criteria then copying them to another place. It works fine unless I
have no rows meeting my criteria. Then I wind up copying the non-filtered
rows instead. Any help would be appreciated. (Range(strEmptyCell finds the
first empty row to copy to.) I'm using the code below:

Sheets(Index).Select
Sheets(Index).Range("a1").AutoFilter _
field:=3, Criteria1:="CF*"
rngCopyRange.Offset(1, 0).Resize(rngCopyRange.Rows.Count - 1, _
rngCopyRange.Columns.Count).Copy

Sheets("Call First").Activate
Range(strEmptyCell).PasteSpecial (xlPasteValues)
Range("A1").Select
Sheets(Index).Activate

Set rngCopyRange = ActiveCell.CurrentRegion
rngCopyRange.Offset(1, 0).Resize(rngCopyRange.Rows.Count - 1, _
rngCopyRange.Columns.Count).Delete
Range("a1", "C1").AutoFilter 'Filter OFF

 

[Norman Jones]

Hi Jeff,

Try something like:

Public Sub Tester02C()
Dim rng As Range
Dim rng1 As Range
Dim destRng As Range
Dim srcSh As Worksheet
Dim destSh As Worksheet

With ActiveWorkbook
Set srcSh = .Sheets("Index")
Set destSh = .Sheets("Call First")
Set destRng = destSh.Range("A10") '<<=== CHANGE
End With

srcSh.Cells.AutoFilter _
field:=2, _
Criteria1:="CF"

Set rng = srcSh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)

On Error Resume Next
Set rng1 = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng1 Is Nothing Then
rng1.Copy Destination:=destRng
End If

srcSh.Cells.AutoFilter

End Sub

 

[Norman Jones]

Hi Jeff,

field:=2, _

Should be:

field:=3, _

 

[Guest]

--
Jeff B

Hi Jeff,


Should be:


---
Regards,
Norman






Thanks, I'll give it a try....

 

[Guest]

Thanks, that helped my out of my "quirk."

 

[Guest]

Hi Norman,
I have a very similar problem. I use the following piece of code (I don't
repeat here the declarations):

For each cella in otherrng
Range("A1").Select
Selection.AutoFilter Field:=2, Criteria1:=cella
Set txtteljes = ActiveSheet.AutoFilter.Range.Rows
Set txtteljes = txtteljes.Offset(1, 0).Resize(txtteljes.Rows.Count -
1, txtteljes.Columns.Count)
Set txtszurt = txtteljes.SpecialCells(xlVisible)
If Not txtszurt Is Nothing Then
Selection.Delete Shift:=xlUp
End If
Selection.AutoFilter
Next

My problem is that when range txtszurt is empty (I see on the screen that no
rows are selected), the
If Not txtszurt Is Nothing Then
condition is still met, and similarly to Jeff's case all rows are deleted.
What's wrong? I hope you come back to this old topic.

Regards,
Stefi


„Norman Jones†ezt írta:

 

[Dave Peterson]

maybe...
Option Explicit
Sub testme()

Dim CellA As Range
Dim otherRng As Range
Dim txtteljes As Range
Dim txtszurt As Range

Set otherRng = Worksheets("sheet2").Range("a1:a3")

For Each CellA In otherRng
Range("A1").AutoFilter Field:=2, Criteria1:=CellA
Set txtteljes = ActiveSheet.AutoFilter.Range.Rows
Set txtteljes = txtteljes.Offset(1, 0) _
.Resize(txtteljes.Rows.Count - 1, _
txtteljes.Columns.Count)
Set txtszurt = Nothing
On Error Resume Next
Set txtszurt = txtteljes.SpecialCells(xlVisible)
On Error GoTo 0
If txtszurt Is Nothing Then
'do nothing
Else
txtszurt.Delete shift:=xlUp
'or txtszurt.entirerow.delete
End If
ActiveSheet.ShowAllData
Next CellA

End Sub

 

[Guest]

Thanks Dave, line
Set txtszurt = Nothing
was the key!

Regards,
Stefi


„Dave Peterson†ezt írta: