Run-time error '1004

Shackleberry

New Member
Joined
Sep 27, 2013
Messages
7
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:
1583345770093.png


1583346259729.png


Here is the code:

VBA 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
 
Last edited by a moderator:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

CSmith

Well-known Member
Joined
Jan 13, 2020
Messages
686
Office Version
  1. 365
  2. 2010
  3. 2007
Platform
  1. Windows
  2. Mobile
  3. Web
Out of curiosity why all the selects?
 

Shackleberry

New Member
Joined
Sep 27, 2013
Messages
7
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.
 

CSmith

Well-known Member
Joined
Jan 13, 2020
Messages
686
Office Version
  1. 365
  2. 2010
  3. 2007
Platform
  1. Windows
  2. Mobile
  3. Web
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:
VBA Code:
    ' 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  ^^^^

VBA Code:
    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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,321
Messages
5,635,570
Members
416,865
Latest member
vipett

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
Top