Code Error

Carl Stephens

New Member
Joined
Jan 3, 2017
Messages
46
Office Version
  1. 365
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
You cannot reference a range that does not exist. Try replacing this:
VBA Code:
        If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

with this (not tested):
VBA Code:
        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.)

 
Upvote 0
You cannot reference a range that does not exist. Try replacing this:
VBA Code:
        If wsData.Range("H1:H" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

with this (not tested):
VBA Code:
        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.)

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

wsData.Range("BD3:BJ" & lr).SpecialCells(xlCellTypeVisible).Copy
 
Upvote 0
Then apply the same test to that line. Example (not tested):
VBA Code:
        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
 
Upvote 0
Then apply the same test to that line. Example (not tested):
VBA Code:
        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.
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top