Code Error

[Carl Stephens]

Hello Everyone,

I have the below code that I have a challenge with. When the macro does not find any new records, I get a run time error 1004 on the red highlighted code below, that says "No cells found", and I would have thought that the "Else" code below would have negated this error from popping up. Can anyone advise what I am doing wrong?

Sub Copydata()
'
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("EPS")
Set wsDest = Worksheets("New Hires")

wsData.Unprotect ("EPS")
wsDest.Unprotect ("NH")

lr = wsData.Cells(Rows.Count, "AP").End(xlUp).Row

If wsData.FilterMode Then wsData.ShowAllData

With wsData.Rows(1)
.AutoFilter Field:=53, Criteria1:="No"
If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("B" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
wsDest.Select
MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " new records were found and copied to the New Hires tab." & vbCrLf & _
"Now press the sort button on the New Hires tab. This will sort in order of join dates, and remove any crew that have joined."

Else
MsgBox "No new employee records found. Please check the New Hires tab to see if there are any schedule changes to these new hires crew."
End If
.AutoFilter Field:=53
Range("A1").Select
wsDest.EnableAutoFilter = True
wsData.EnableAutoFilter = True
wsData.Protect Password:="EPS", UserInterfaceOnly:=True
wsDest.Protect Password:="NH", UserInterfaceOnly:=True
End With
Application.ScreenUpdating = True

End Sub

 

[rlv01]

You cannot reference a range that does not exist. Try replacing this:

        If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

with this (not tested):

        If Not wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then

(Tip: For future posts , you should try to use code tags like I did above when posting your code. It makes it easier to read.)

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

 

[Carl Stephens]

You cannot reference a range that does not exist. Try replacing this:

        If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

with this (not tested):

        If Not wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then

(Tip: For future posts , you should try to use code tags like I did above when posting your code. It makes it easier to read.)

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

Thank you, it is still giving me the same error on this code below.

wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy

 

[rlv01]

Then apply the same test to that line. Example (not tested):

        If Not wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then
            If Not wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then
                wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
                wsDest.Range("B" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
                wsDest.Select
                MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " new records were found and copied to the New Hires tab." & vbCrLf & _
                "Now press the sort button on the New Hires tab. This will sort in order of join dates, and remove any crew that have joined."
            Else
                MsgBox "Nothing to copy!"
            End If
        Else
            MsgBox "No new employee records found. Please check the New Hires tab to see if there are any schedule changes to these new hires crew."
        End If

 

[Carl Stephens]

Then apply the same test to that line. Example (not tested):

        If Not wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then
            If Not wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible) Is Nothing Then
                wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
                wsDest.Range("B" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlPasteValues
                wsDest.Select
                MsgBox wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " new records were found and copied to the New Hires tab." & vbCrLf & _
                "Now press the sort button on the New Hires tab. This will sort in order of join dates, and remove any crew that have joined."
            Else
                MsgBox "Nothing to copy!"
            End If
        Else
            MsgBox "No new employee records found. Please check the New Hires tab to see if there are any schedule changes to these new hires crew."
        End If

Thank you again, but same error appears.