Paste Link Random Error - vba

Question

To provide a snapshot of how the code functions:
User Clicks button to Import Job Folder
File Path Selection Opens and User Selects File
VBA Imports Specified Cell Values from Job File and Pastes link to sheet.
Everything works fine except once in a while I get a error that says "No link to paste" and reference the ActiveSheet.Paste Link:=True Line but if I hit the runsub button on the VBA code editor it works. I don't know why I get this Error sometimes. Is there a way to make the code rerun on that error?
The Error occurs at any of the ActiveSheet.Paste Link:=True in the code shown below, again at random and at any of the Import Selections (Project Name or Client Name or Project Name etc)
'Imports Project#
sourcewb.Sheets("Estimate").Range("PROJECT_NUMBER").Copy 'project# info is located on "Reporting" tab
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 1).Select
ActiveSheet.Paste Link:=True
'Imports Client Name
sourcewb.Sheets("Estimate").Range("PROJECT_CLIENT").Copy 'C3 is where client name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 2).Select
ActiveSheet.Paste Link:=True
'Imports Project Name
sourcewb.Sheets("Estimate").Range("PROJECT_NAME").Copy 'C2 is where project name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 3).Select
ActiveSheet.Paste Link:=True
'Imports Latest Revision Date
sourcewb.Sheets("Reporting").Range("O5").Copy 'P5 is where project name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 19).Select
ActiveSheet.Paste Link:=True
0
'Imports data from Project Total line
sourcewb.Sheets("Reporting").Range("C24:Q24").Copy 'Row 24 is where Project Total line is located on "Reporting"
PTRange = "D" & NewRow & ":" & "R" & NewRow
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Range(PTRange).Select
ActiveSheet.Paste Link:=True
Below is the full code:
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'
'This code imports select data from specified project's cost tracking spread sheet.
'
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sub ImportProjectStatus()
'Minimize runtime
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Initialize Variables
Dim summarywb As Workbook
Dim sourcewb As Workbook
Dim currentVer As String
Dim FirstRow As Long
Dim LastRow As Long
Dim NewRow As Long
Dim NewJobNumber As String
Dim PTRange As String
'Set initial values
Set summarywb = ThisWorkbook
currentVer = "0.8.0"
'Open file selection dialog box
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
openFile = Application.FileDialog(msoFileDialogOpen).Show
If openFile <> 0 Then
sourcewbpath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'Select the corresponding master file
Else
sourcewbpath = ""
Exit Sub
End If
Set sourcewb = Workbooks.Open(sourcewbpath)
'Error Handling - If there is no reporting tab on a tracking sheet
On Error GoTo NoReportTabError
'Searches for first non-blank row with data
FirstRow = summarywb.ActiveSheet.Cells.Find(What:="Project #", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row + 1
'Searches for last non-blank row
LastRow = summarywb.ActiveSheet.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'Sets Row to which new data will be imported
NewRow = LastRow + 1
'Checks if to-be imported job number is a duplicate
NewJobNumber = sourcewb.Sheets("Reporting").Range("P2")
If DuplicateCheck(summarywb, FirstRow, LastRow, NewRow, NewJobNumber) = 1 Then
If MsgBox(NewJobNumber & " already exists. Continue?", vbYesNo, "Confirm") = vbNo Then
'Close sourcewb
sourcewb.Close savechanges:=False
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Abort message
MsgBox "Job not added."
Exit Sub
End If
End If
'Imports Project#
sourcewb.Sheets("Estimate").Range("PROJECT_NUMBER").Copy 'project# info is located on "Reporting" tab
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 1).Select
ActiveSheet.Paste Link:=True
'Imports Client Name
sourcewb.Sheets("Estimate").Range("PROJECT_CLIENT").Copy 'C3 is where client name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 2).Select
ActiveSheet.Paste Link:=True
'Imports Project Name
sourcewb.Sheets("Estimate").Range("PROJECT_NAME").Copy 'C2 is where project name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 3).Select
ActiveSheet.Paste Link:=True
'Imports Latest Revision Date
sourcewb.Sheets("Reporting").Range("O5").Copy 'P5 is where project name info is located on "Reporting"
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Cells(NewRow, 19).Select
ActiveSheet.Paste Link:=True
'Imports data from Project Total line
sourcewb.Sheets("Reporting").Range("C24:Q24").Copy 'Row 24 is where Project Total line is located on "Reporting"
PTRange = "D" & NewRow & ":" & "R" & NewRow
summarywb.ActiveSheet.Activate
summarywb.ActiveSheet.Range(PTRange).Select
ActiveSheet.Paste Link:=True
'Adds "N" to closed column
summarywb.ActiveSheet.Cells(NewRow, 20) = "N"
CleanExit:
'Line to display which line a new job was added to
MsgBox NewJobNumber & " added to line " & NewRow
'Close sourcewb
sourcewb.Close savechanges:=False
'Refresh Data (Note. Refreshes all links)
RefreshAllLinks
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
NoReportTabError:
MsgBox "No Reporting tab found on the specified Tracking workbook. Closing Macro."
'Close sourcewb
sourcewb.Close savechanges:=False
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'
'This code checks for job numbers that are duplicate of the one to be added.
'
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Function DuplicateCheck(summarywb, FirstRow, LastRow, NewRow, NewJobNumber)
Dim CheckCell As String
summarywb.ActiveSheet.Activate
For i = FirstRow To LastRow
Range("A" & i).Select
Selection.Copy
Range("A" & NewRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=Flase, Transpose:=False
CheckCell = Cells(NewRow, 1).Value
If CheckCell = NewJobNumber Then
DuplicateCheck = 1
Range("A" & NewRow).Clear
Exit Function
End If
Range("A" & NewRow).Clear
Next i
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'
'This code refreshes all links in the active worksheet.
'
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sub RefreshAllLinks()
'Minimize runtime
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Initialize Variables
Dim summarywb As Workbook
'Set initial values
Set summarywb = ThisWorkbook
'Refresh all linked data
summarywb.ActiveSheet.Activate
summarywb.UpdateLink Name:=summarywb.LinkSources
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'
'This code moves highlighted line(s) of data from current to archive tab.
'
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sub ArchiveData()
'Minimize runtime
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Initialize Variables
Dim summarywb As Workbook
Dim LastRow As Long
Dim NewRow As Long
'Set initial values
Set summarywb = Workbooks("Project Status Summary.xlsm")
'Asks for confirmation
If MsgBox("Archive highlighted job(s)?", vbYesNo, "Confirm") = vbNo Then
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Abort message
MsgBox "Job(s) not archived."
Exit Sub
End If
'Finds last non-blank row on Archive sheet
Worksheets("Archive").Activate
LastRow = summarywb.Sheets("Archive").Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'Assigns row number for a new line
NewRow = LastRow + 1
'Copies and pastes data from Current tab to Archive tab
Worksheets("Current").Activate
Selection.Copy
Worksheets("Archive").Activate
Range("A" & NewRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=Flase, Transpose:=False
''Displays confirmation message
MsgBox ("Job(s) archived.")
'Display back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

If the copy fails intermittently, it might be a race condition. Here's a little snippet that retries the paste a few times:
Sub PasteEx()
On Error Resume Next
Err.Clear
ActiveSheet.Paste Link:=True
If Err.Number = 0 Then
GoTo PasteEx_Exit
Else
For i = 1 To 3
Err.Clear
ActiveSheet.Paste Link:=True
If Err.Number = 0 Then
GoTo PasteEx_Exit
End If
Application.Wait Now + TimeValue("0:00:01") ' Adjust as needed
Next i
End If
On Error GoTo 0
Err.Raise 1004
PasteEx_Exit:
On Error GoTo 0
End Sub
Add this method and replace your ActiveSheet.Paste Link:=True with PasteEx.
There is a delay in there. Adjust it as needed.
Since I can't reproduce your conditions, I'm not sure if it will help you. Give it a try!