Special Cells on blank failure!!!

[rfletcher35]

I have the following code

Sheets("MPR Data").Select
ActiveSheet.Range("$T$4:$AD$4000").AutoFilter Field:=9, Criteria1:="x"
ActiveSheet.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="365"
If Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Value > "" Then
Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Results Sheet").Select
Range("P5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
End If

My code is failing at the line If Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Value > "" Then
I have the above filters in place and sometimes the filters return nothing and when it does it fails as it tries to copy nothing. I'm trying to put a step in to avoid that, so if filters produce nothing it goes on to the next part of my coding.

Can anyone assist with this please?


Thanks

Fletch

 

[Norie]

Perhaps.

Dim rng As Range

    With Sheets("MPR Data")
        .Range("$T$4:$AD$4000").AutoFilter Field:=9, Criteria1:="x"
        .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="365"
        On Error Resume Next
        Set rng = .Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Value
        On Error GoTo 0
    End With

    If Not rng Is Nothing Then
        rng.Copy
        Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
    End If

 

[rfletcher35]

Hi I implemented the above code as below and whilst it doesn't crash it also doesn't seem to copy and paste the filtered data either?

Dim rng As Range
With Sheets("MPR Data")
'.Range("$T$4:$AD$4000").AutoFilter Field:=9, Criteria1:="x"
.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=358", Operator:=xlFilterValues, Criteria2:="<364", Operator:=xlFilterValues
On Error Resume Next
Set rng = .Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Value
On Error GoTo 0
End With
If Not rng Is Nothing Then
rng.Copy
Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
End If

 

[Fennek]

Hi,

don't use "select" and "visible cells"

without testing:

with Sheets("MPR Data").Range("$T$4:$AD$4000")
.AutoFilter Field:=9, Criteria1:="x"
.ActiveSheet.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="365"
.Copy Sheets("Results Sheet").Range("P5").paste
end with

If you realy need "paste special" then in two lines

regards

 

[rfletcher35]

Hi,

That fails on .ActiveSheet.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="365"
If I take out .ActiveSheet and start it from .Range it goes past this line but then fails on .Copy Sheets("Results Sheet").Range("P5").paste

Any ideas. I just want to be able to copy what ever filtered data is there and paste it. Because it's filtered it won't always be the same row which is why specialcells came into it. But I also need something in there so it ignores when there is no data to copy once filtered.

Fletch

 

[Marcelo Branco]

Hi I implemented the above code as below and whilst it doesn't crash it also doesn't seem to copy and paste the filtered data either?

Dim rng As Range
With Sheets("MPR Data")
'.Range("$T$4:$AD$4000").AutoFilter Field:=9, Criteria1:="x"
.Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=358", Operator:=xlFilterValues, Criteria2:="<364", Operator:=xlFilterValues
On Error Resume Next
Set rng = .Range("T5:AB4000").SpecialCells(xlCellTypeVisible).Value
On Error GoTo 0
End With
If Not rng Is Nothing Then
rng.Copy
Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
End If

Maybe...

Dim rng As Range

With Sheets("MPR Data")
    '.Range("$T$4:$AD$4000").AutoFilter Field:=9, Criteria1:="x"
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=358", [COLOR=#0000ff]Operator:=xlAnd[/COLOR], Criteria2:="<364", Operator:=xlFilterValues
    On Error Resume Next
    [COLOR=#0000ff]Set rng = .Range("T5:AB4000").SpecialCells(xlCellTypeVisible)[/COLOR]
    On Error GoTo 0
End With

If Not rng Is Nothing Then
    rng.Copy
    Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
End If

Hope this helps

M.

 

[rfletcher35]

Gonna do a few test but that looks spot on thanks!