Run-time Error 1004, No cells were found

RemcoVBA

New Member
Joined
Sep 21, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Dear all,

I'm the match secretary of our local football club. Each weekend I need to provide an overview of all matches to be played that weekend, showing which field, what time, etc.
I've build an excel sheet to generate this overview from an export from the special software we use to plan the matches.

My knowledge of VBA is quite limited but by browsing on forums, recording macros and looking at the code and some common sense I managed to build a script that does exactly what I want.


I'm using the autofilter function to identify all matches to be played on Friday, Saturday and Sunday.
For each day I copy / paste all the matches to a seperate section on another sheet.

Everything works fine until there's no match to be played on one of the days mentioned above.
A message 'Run-time Error 1004, No cells were found' pops up and the script will stop.
I've been looking for solutions a couple of hours, but nothing seems to work.

Can anyone guide me into the right direction?
Basiscally what I want the script to do is when it doesn't find matches for friday it should continue to run and trying to find matches for saturday.

Thanks
Remco


Below is (part of) my script:
VBA Code:
'Autofilter Home matches saturday

ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="saturday"



'Copy visible cells

Dim rSource As Range
Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)

rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home matches
Sheets("Home matches").Select
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
       
'Autofilter Home matches friday

Sheets("Voorbereiding").Select
ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="friday"



'Copy visible cells

Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home matches
Sheets("Home matches").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
'Autofilter Home matches Sunday

Sheets("Voorbereiding").Select
ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="sunday"


'Copy visible cells

Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home Matches
Sheets("Home Matches").Select
Range("A39").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
You can replace all that code with
VBA Code:
Sub RemcoVBA()
   Dim Ary As Variant
   Dim i As Long
   Dim Ws As Worksheet
   
   Set Ws = Sheets("Home matches")
   Ary = Array("saturday", "A11", "friday", "A6", "sunday", "A39")
   
   For i = 0 To UBound(Ary) Step 2
      With Sheets("Voorbereiding")
         .Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
         .Range("A:Q").AutoFilter Field:=16, Criteria1:=Ary(i)
         .AutoFilter.Range.Offset(1).Resize(, 13).Copy
         Ws.Range(Ary(i + 1)).PasteSpecial xlPasteValues
      End With
   Next i
End Sub
 
Upvote 0
One way is testing for filter results before trying to copy. Like this.
You'd need to do that for each section.

Rich (BB code):
'Autofilter Home matches saturday

ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="saturday"

'Copy visible cells
If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
  Dim rSource As Range
  Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
  
  rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
  
  'Paste to sheet Home matches
  Sheets("Home matches").Select
  Range("A11").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       
End If
 
Upvote 0
Solution
Wow, you guys are true heros! It solved my problem and my script is running flawless! And you guys provided me the answers only a few minutes after my post!
Thank you so much!

ps: apologies for not tagging my question. Will sure do next time.
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,212,934
Messages
6,110,762
Members
448,295
Latest member
Uzair Tahir Khan

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