Run-time error '1004': No cells were found.

sspatriots

Well-known Member
Joined
Nov 22, 2011
Messages
585
Office Version
  1. 365
Platform
  1. Windows
I posted the first part of my code earlier, but now I need expand it to allow sorting of other columns in the source table and extracting information from them to be added to the destination table. I keep getting the subject error at the line below in my code:

VBA Code:
Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

The reason for this is that when I filter the column (using the line of code below) for dates within the next 7 days, the result is no data in that column falling within that date range, therefor I end up with an empty set of data for the result when filtering on this particular column. It will probably happen to other columns I try to filter as I add them to this code later on.

VBA Code:
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7


I tried using various techniques I found on this group to trap it, but nothing seems to work or I'm just not doing something correctly. Any help would be greatly appreciated.


Below is the complete code so far:
VBA Code:
Sub PopulateOrderByReportWS()
'
' Populate Order By Report WS Macro
'
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim tb1 As ListObject
    Dim tb2 As ListObject
    Dim lc1 As ListColumn
    Dim lc2 As ListColumn
    Dim lc3 As ListColumn
    Dim lc4 As ListColumn
    Dim lc5 As ListColumn
    Dim lc6 As ListColumn
    Dim Rng1 As Range
    Dim col1 As Long
    Dim col2 As Long
    Dim col3 As Long
    Dim col4 As Long
    Dim col5 As Long
    Dim col6 As Long
    Dim i As Long
    Dim lRw As Long
    
    Set Ws1 = Sheets("Jobs") 'Worksheet the G2JobList (Source) Table is on
    Set Ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    Set tb1 = Ws1.ListObjects("G2JobList") 'Source Table
    Set tb2 = Ws2.ListObjects("Order_By_Report")  'Destination Table
    Set lc1 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "PO")
    Set lc2 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc3 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
    Set lc4 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc5 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "PO")
    Set lc6 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "Order By" & Chr(10) & "Date")
    
    col1 = lc1.Range.Column
    col2 = lc2.Range.Column
    col3 = lc3.Range.Column
    col4 = lc4.Range.Column
    col5 = lc5.Range.Column
    col6 = lc6.Range.Column

    Ws2.Activate

    On Error Resume Next
    tb2.DataBodyRange.Delete

    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col1
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col2, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7

    With tb1

        On Error GoTo EQPT2
        
        Ws2.Activate
    
        Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy
    
        With Range("Order_By_Report[[Job Name]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
            
        End With
            
        Range("G2JobList[[Jack" & Chr(10) & "Vendor]], G2JobList[[Jack" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
        
        With Range("Order_By_Report[[Vendor]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
        End With

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
     
    End With
    
    For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
        If Rng1 = vbNullString Then Rng1 = "Jack"
'        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
    
        lRw = Cells(Rows.Count, 1).End(xlUp).Row
     
    Next


EQPT2:


    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col3
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col4, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7

    With tb1
        
        On Error GoTo EQPT3
        
        Range("G2JobList[[Job Name]], G2JobList[[MFR" & Chr(10) & "Machine" & Chr(10) & "PN]], G2JobList[[Machine" & Chr(10) & "Vendor]], G2JobList[[Machine" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
    
        Ws2.Activate
    
        With Range("Order_By_Report[[Job Name]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
        End With

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    
    End With
    
    For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
        If Rng1 = vbNullString Then Rng1 = "Machine"
'        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
    
        lRw = Cells(Rows.Count, 1).End(xlUp).Row
     
    Next
    
    
EQPT3:
    
    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col5
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7
    
    With tb1

        On Error GoTo EQPT4
      
        Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

        Ws2.Activate

        With Range("Order_By_Report[[Job Name]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
        End With
            
        Range("G2JobList[[Safety" & Chr(10) & "Vendor]], G2JobList[[Safety" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
        
        With Range("Order_By_Report[[Vendor]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
        End With

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    
    End With
    
    For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
        If Rng1 = vbNullString Then Rng1 = "Safety"
'        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
    
        lRw = Cells(Rows.Count, 1).End(xlUp).Row
     
    Next
  
    
EQPT4:
    
'Code for next column will go here
    
    
    Application.Goto Reference:=Range("A" & lRw), Scroll:=True

    Range("B3").Activate

End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
I keep getting the subject error at the line below in my code:

VBA Code:
Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy
It is a bit hard to follow all the code since we don't have the data/tables etc to test with but try wrapping that section of code like this
Try wrapping that line like this

Rich (BB code):
If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
  Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

  Ws2.Activate

  With Range("Order_By_Report[[Job Name]]")
      n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Cells(n + 1, .Column).PasteSpecial xlPasteValues
  End With
End If
The gist of it is to count the visible cells in the entire table column, including heading. Since the heading row will always be visible, that count will always be 1 or greater - so no error. If it is 1, only the heading is visible so no data rows are visible but if the count is greater than 1 then you must have at least one visible data row to copy.

Looks like you might have some other sections of code that need a similar check.
 
Upvote 0
Solution
It is a bit hard to follow all the code since we don't have the data/tables etc to test with but try wrapping that section of code like this
Try wrapping that line like this

Rich (BB code):
If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
  Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

  Ws2.Activate

  With Range("Order_By_Report[[Job Name]]")
      n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Cells(n + 1, .Column).PasteSpecial xlPasteValues
  End With
End If
The gist of it is to count the visible cells in the entire table column, including heading. Since the heading row will always be visible, that count will always be 1 or greater - so no error. If it is 1, only the heading is visible so no data rows are visible but if the count is greater than 1 then you must have at least one visible data row to copy.

Looks like you might have some other sections of code that need a similar check.
WOW!! This is genius. I think I got close to this a few times, but could not get to the finish line. I think at one point all I was missing was the "#All" in the part that you show in your response. Excellent. Thank you so much!!!
 
Upvote 0
You're welcome.

BTW, The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.
 
Upvote 0
You're welcome.

BTW, The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.
That was an accident I think. Thanks again.
 
Upvote 0

Forum statistics

Threads
1,224,812
Messages
6,181,088
Members
453,021
Latest member
Justyna P

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