Special Cells ignoring blanks

[rfletcher35]

I have the following code, the top part works fine but the part in bold fails, can anyone explain why??

   Set CurMonth = Range("C2")
    With Sheets("MPR Data")
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error Resume Next
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
End If
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error Resume Next
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    'Range("P5" & Rows.Count).End(xlUp).Offset(1).Select
    Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If

Thanks

Fletch

 

[JoeMo]

What fails - what's the error message or failure mode?

 

[rfletcher35]

The criteria on the second set once filtered has no data but for some reason it pastes the previous info instead of pasting nothing.

 

[JoeMo]

The criteria on the second set once filtered has no data but for some reason it pastes the previous info instead of pasting nothing.

After the first set is pasted add this line:

Application.CutCopyMode = False

 

[rfletcher35]

ADVERTISEMENT

Hi think we are on the right track, however now I get a runtime error 1004 on the following line

Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Select

I seem to think that it is not recognising the line

Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

 

[JoeMo]

Hi think we are on the right track, however now I get a runtime error 1004 on the following line

Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Select

I seem to think that it is not recognising the line

Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

More likely the sheet "Results Sheet" is not active when you reach that line. You can't select a range on that sheet if it's not the active sheet. Change that line to this:

Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

 

[rfletcher35]

ADVERTISEMENT

Hi I tried that but even though it releases the previous data with cut copy mode it still pastes that data in again. The bold bit below just pastes the previous data again. which now makes me think that the previous error checking may not be working.
All I want it to do is paste visible data, the second set appended to then next blank row of the previous. If there is no data then skip this. I'm sure I've done this before but just can't get my head around it.

Any suggestions?

Fletch

    Dim rng365 As Range
    Dim CurMonth As Range
    
    ', Operator:=xlAnd, Criteria2:=">=365" xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    
    Sheets("Results Sheet").Select
    Range("P5:BL3000").Select
    Selection.ClearContents
    
'   Once date of start of project is confirmed dates will require adjusting from that point!!!!!!!!!!!!
'   365 - 1 Year of Work No Absence
    Set CurMonth = Range("C2")
    With Sheets("MPR Data")
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error Resume Next
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
End If
    Application.CutCopyMode = False
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error Resume Next
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    'Range("P5" & Rows.Count).End(xlUp).Offset(1).Select
    Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If

 

[JoeMo]

Have you stepped through your code to see if there are any visible cells after the second filtering? If not, then rng365 remains as previously set in the first filtering and is pasted again.

 

[rfletcher35]

If I changed the Range Name for the second set do you think this would work?

 

[JoeMo]

If I changed the Range Name for the second set do you think this would work?

It would work to the extent of not doing a paste if the new range variable is Nothing.