Avoiding Run Time Error

**emilyloz** · 06-05-2013, 08:12 AM

Hello,

I currently have a spread sheet where the user enters 'y' in the G column. If a y is entered, the user can then press the 'Update' button, and the rows containing a y in the g column will be moved to a different sheet, 'History'.

It works fine if there are y's entered into the column, but I want to be able to avoid the user getting: "Run-Time Error '1004': no cells were found" when no y's are entered into the g column.

The current code is this:

Private Sub UpdateHistory2_Click()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet, ms As Worksheet
    Set ws = Sheets("Current Contractors")
    Set ms = Sheets("History Contractors")

    ws.ListObjects("Table1").Range.AutoFilter

    With ms
        'heading:
        .Range(.Cells(1, 1), .Cells(1, 8)).Value = Array("Today's Date", _
                                                         "Purchase Order Date", _
                                                         "Contractor", _
                                                         "Equipment", _
                                                         "Description", _
                                                         "Expected Time of Completion", _
                                                         "Completed? y or n", _
                                                         "Time of Completion")
    
    End With
    With ws.Range("A1:H" & ws.Cells.Find("*", , , , xlByRows, xlPrevious).Row)
            
            .AutoFilter 7, "y"
            .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
            ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .Resize(.Rows.Count - 1).Offset(1).EntireRow.Delete Shift:=xlUp
            .AutoFilter
        
    End With
    
    Application.ScreenUpdating = True
    
End Sub

I have attached my work book. The following code is for Current Contractors and History Contractors, although almost the exact code is being used for Maintenance Sheets.

Please Help

**JosephP** · 06-05-2013, 08:21 AM

perhaps change

            
            .AutoFilter 7, "y"
            .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
            ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .Resize(.Rows.Count - 1).Offset(1).EntireRow.Delete Shift:=xlUp
            .AutoFilter

to

            
            .AutoFilter 7, "y"
            if .columns(1).SpecialCells(xlCellTypeVisible).count > 1 then
               .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
               ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
               .Resize(.Rows.Count - 1).Offset(1).EntireRow.Delete Shift:=xlUp
            end if
            .AutoFilter

**ragulduy** · 06-05-2013, 08:23 AM

Private Sub UpdateHistory()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet, ms As Worksheet
    Set ws = Sheets("Current Contractors")
    Set ms = Sheets("History Contractors")

    ws.ListObjects("Table1").Range.AutoFilter

    With ms
        'heading:
        .Range(.Cells(1, 1), .Cells(1, 8)).Value = Array("Today's Date", _
                                                         "Purchase Order Date", _
                                                         "Contractor", _
                                                         "Equipment", _
                                                         "Description", _
                                                         "Expected Time of Completion", _
                                                         "Completed? y or n", _
                                                         "Time of Completion")
    
    End With
    With ws.Range("A1:H" & ws.Cells.Find("*", , , , xlByRows, xlPrevious).Row)
            
            .AutoFilter 7, "y"
            On Error GoTo no_cells
            .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
            On Error GoTo 0
            ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .Resize(.Rows.Count - 1).Offset(1).EntireRow.Delete Shift:=xlUp
            .AutoFilter
          
        
    End With
    
    Application.ScreenUpdating = True
    End Sub
no_cells:
    Application.ScreenUpdating = True
End Sub

**Jakobshavn** · 06-05-2013, 08:25 AM

Put these lines at the top (before the ScreenUpdating line):

Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Dim r As Range, y As String
Set r = Range("G:G")
y = "y"
If wf.CountIf(r, y) = 0 Then Exit Sub