Copy Problem From Advanced Filter

[Ark68]

I am having a difficult time figuring out why mu code to copy the advanaced filter results from one worksheet to another is failing. The data to be filtered is in worksheet "Data" and the results of the filter ("Criteria A19:A20") are to be copied to "Dia_Temp A2"

The filter appears to be working OK, it's just not copying the data.

Here is my code:

    llastrow = 0
    ldiacopy = 0
    Sheets("Data").Activate
    With Worksheets("Data")
        If .FilterMode Then .ShowAllData
        llastrow = Range("a65536").End(xlUp).Row
        With .Range("A1:M" & llastrow)
            .AdvancedFilter _
                    Action:=xlFilterInPlace, _
                    CriteriaRange:=Worksheets("Criteria").Range("A19:A20"), _
                    Unique:=False
            On Error Resume Next
            Set rngToCopy = .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            ldiacopy = rngToCopy.Count
            If ldiacopy = 0 Then
                MsgBox ("There are no diamond records found." & chlr & "Press OK to continue.")
            End If
                 
        End With
         If .FilterMode Then .ShowAllData

     End With

     If Not rngToCopy Is Nothing Then rngToCopy.EntireRow.Copy Destination:=Dia_Temp.Range("A2")

Jenn

 

[Datsmart]

What does the variable Dia_Temp equal?
If it is a worksheet name you are using the wrong syntax.

 

[Ark68]

Ahhhh .... I have been enlightened.
I used the wrong variable there, I meant to use the variable I had defined earlier to specify the destination worksheet.

Jenn

 

[Colin Legg]

To be safe, this line:

llastrow = Range("a65536").End(xlUp).Row

Should be:

llastrow = .Range("a65536").End(xlUp).Row

And here:

            On Error Resume Next
            Set rngToCopy = .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            ldiacopy = rngToCopy.Count
            If ldiacopy = 0 Then
                MsgBox ("There are no diamond records found." & chlr & "Press OK to continue.")
            End If
                 
        End With
         If .FilterMode Then .ShowAllData
     End With
     If Not rngToCopy Is Nothing Then rngToCopy.EntireRow.Copy Destination:=Dia_Temp.Range("A2")

Your On Error Resume Next statement is covering up too many potential bugs (every line that follows). I think you could replace that code with:

            'if there are no visible cells then we will get an error. we will ignore it.
            On Error Resume Next
            Set rngToCopy = .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            'resume normal error handling.
            On Error GoTo 0
 
        End With
         If .FilterMode Then .ShowAllData
     End With
 
     'did we find any diamond records?
     If rngToCopy Is Nothing Then
        MsgBox ("There are no diamond records found." & chlr & "Press OK to continue.")
     Else
        rngToCopy.EntireRow.Copy Destination:=Dia_Temp.Range("A2")
     End If

Not sure what chlr is though?