Run-time error '1004

[Shackleberry]

Hello Experts:
I have a rather irritating problem that does not make sense to me and I am hoping that someone can help please. I have some code that:

1. Creates a list of files to be opened
2. Opens each file in the list and scrapes some specific data from each file opened if present
3. Places the scraped data into an aggregated file
4. The first file is then removed from the list and the process loops again until all files have been opened and scraped

My problem: The process stalls inconsistently at the "Activesheet.Paste" step where I get the Run-time '1004 error. I then have to jump start the code by moving the yellow arrow back up to the Workbooks.Open line and the process resumes by opening the very same file without a problem. Then maybe 10 files later...the problem happens again. For 160 files to be opened and scraped, I probably have to do this about 7 or 8 times...and again the stall is not consistently happening on the same files each time...so this has nothing to do with the specific data in the file.

What can I do to eliminate the unpredictable stalls for no apparent reason?

The process stalls here:

Here is the code:

Sub IWR_Actuals_Date_Check()
'
' Written by Buz Hillman 18Jan2018
' It will assemble a list of IWR trials and extract line 1 from every data file
' This will also calculate the date that the last patient was dosed

    Workbooks.Add
''''''''''''''''''''''''''''''''''
    Dim x As Long
    Dim y As Long
    Dim cell As Range

'Optimize Code Start - the turns off the screen refresh to improve speed
    Call OptimizeCode_Begin
''''''''''''''''''''''''''''''''''
'Open the index and prepare the operating list
'Turn off alerts
    Application.DisplayAlerts = False
   
    Sheets.Add.Name = "Index"
    Sheets.Add.Name = "LoopingProcess"
    Workbooks.Open filename:= _
        "\\Na.jnj.com\cntusdfsroot\Departmental\Clinical\Diagserv\Clinical Supplies Planning\Macros\Dashboard_List.xlsx"
  
    Range("A6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(2, 0).Select
    ActiveSheet.Paste
    Sheets("Index").Select
    Range("C6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("Index").Select
    Range("E6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("Index").Select
    Range("G6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("Index").Select
    Range("I6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Columns("A:K").Copy
    ActiveWindow.Close
    Sheets("Index").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").FormulaR1C1 = "=R[1]C&"".csv"""
    Range("M1").Select
    Selection.FormulaR1C1 = "=NOW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'File open list is complete

'Beginning of looping process
    Do
    Rows("2:2").Delete Shift:=xlUp
    Range("A1").FormulaR1C1 = "=R[1]C&"".csv"""
    Sheets("Index").Select
    Workbooks.Open filename:= _
        "\\Na.jnj.com\cntusdfsroot\Departmental\Clinical\Diagserv\Clinical Supplies Planning\Daily IWR Optimizer Files\" & Range("A1") _
        , Origin:=xlWindows, ReadOnly:=True
    Range("N1").FormulaR1C1 = "=COUNTIF(C[-13],14)"
    If Range("N1") > 0 Then
    Range("M1").Select
    Selection.FormulaR1C1 = "=IF(RC[-12]=14,RC[-9],"""")"
    Selection.Copy
    Range("A1").Select
    Selection.End(xlDown).Offset(0, 12).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Goto Reference:="R1C8"
    ActiveCell.FormulaR1C1 = "=MAX(C[5])"
    Range("H1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Else
    Range("H1").FormulaR1C1 = 0
    End If
   
    Range("A1:H1").Copy
    ActiveWindow.Close
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("Index").Select

'Loop continuously until all lines have been processed and there are no files to be opened
    Range("A1").Select
    Loop Until ActiveCell.Offset(2, 0) = ""

'Optimize Code End - the turns on the screen refresh that was turned off in the beginning to improve speed
    Call OptimizeCode_End
    Workbooks.Open filename:= _
        "\\Na.jnj.com\cntusdfsroot\Departmental\Clinical\Diagserv\Clinical Supplies Planning\Macros\IWR Trial List.xlsx"
    Columns("A:B").Copy

    ActiveWindow.Close
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("LoopingProcess").Select
    Range("F2").Select
    Selection.FormulaR1C1 = "=TODAY()-RC[-1]"
    Selection.NumberFormat = "0"
    Range("G2").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-5],Sheet1!C[-6]:C[-5],2,FALSE),""No"")"
    Range("F2:G2").Copy
    Range("E2").Select
    Selection.End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveSheet.Range("$A$1:$G$500").AutoFilter Field:=6, Criteria1:=">3", _
        Operator:=xlAnd

'Column headers and general formatting
    Range("A1").FormulaR1C1 = "RecType"
    Range("B1").FormulaR1C1 = "Trial ID"
    Range("C1").FormulaR1C1 = "Trial Name"
    Range("D1").FormulaR1C1 = "Start Date"
    Range("E1").FormulaR1C1 = "Report Date"
    Range("F1").FormulaR1C1 = "Days since last transmission"
    Range("G1").FormulaR1C1 = "Active in OMP"
    Range("H1").FormulaR1C1 = "Last Dose Date"
    Columns("A:A").ColumnWidth = 8
    Columns("F:G").ColumnWidth = 10
    Columns("F:F").ColumnWidth = 27
    Columns("H:H").NumberFormat = "ddmmmyy"
    Columns("F:F").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Range("A1").Select
      
    MsgBox "All data have been processed. Have a great day!", vbOKOnly

'Turn on alerts
    Application.DisplayAlerts = True



End Sub

 

[CSmith]

Out of curiosity why all the selects?

 

[Shackleberry]

I am not a classically trained code writer. I am self-taught and do the best I can with the knowledge that I have and I am always open to learning new things.

 

[Shackleberry]

Thanks for the question.

 

[CSmith]

My first suggestion would be to get rid of the selects and just use a Range object to tell your code what item/cells are needing to be copied.

Same code for column A without selects:

    ' Part to copy  vvvv
    Range("A6:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy _
        Sheets("LoopingProcess").Range("A" & Cells(Sheets("LoopingProcess").Rows.Count, 1).End(xlUp).Row + 2)
    '   Destination  ^^^^

    Range("A6").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("LoopingProcess").Select
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(2, 0).Select
    ActiveSheet.Paste

Welcome!

Thanks for the question.