Color in Hyperlinks that cant be opened

[GormanRupp]

I currently have code that allows me to create hyperlinked formulas and open the pdf's based on part numbers, but some of the part numbers links do not exist. I was wondering if instead of on error resume next, is there a way to color in the cell that Errors and resume at the same time? It can be any color.


Sub hyperlinkprint()
'
' hyperlinkprint Macro
'
'
'
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("D2:D" & Lastrow).FormulaR1C1 = _
"=HYPERLINK(""C:\Cut Sheets NEW\""&RC[-3]&"".pdf"",RC[-3])"

Dim Cell As Range
If (MsgBox("POpen All pdf Links Available?", vbYesNo) = vbYes) Then
Lastrow = Range("D" & Rows.Count).End(xlUp).Row
For Each Cell In Range("D2:D" & Lastrow)
On Error Resume Next
ThisWorkbook.FollowHyperlink "C:\Cut Sheets NEW\" & Cell.Value & ".pdf"
On Error GoTo 0
Next Cell
End If
End Sub

 

[dermie_72]

you could try:

on error GoTo nofilefound

Then before your end sub put:
nofilefound:
Cell.interior.colorindex = 6
Resume

I haven't tested it so not 100% sure what color, but the theory should be sound. If the Cell.Interior.Colorindex part doesn't work, just just need to find a way to color in the cell causing the issue. But the on error part should at least point you in the right direction.

 

[Rick Rothstein]

I currently have code that allows me to create hyperlinked formulas and open the pdf's based on part numbers, but some of the part numbers links do not exist. I was wondering if instead of on error resume next, is there a way to color in the cell that Errors and resume at the same time? It can be any color.


Sub hyperlinkprint()
'
' hyperlinkprint Macro
'
'
'
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("D2:D" & Lastrow).FormulaR1C1 = _
"=HYPERLINK(""C:\Cut Sheets NEW\""&RC[-3]&"".pdf"",RC[-3])"

Dim Cell As Range
If (MsgBox("POpen All pdf Links Available?", vbYesNo) = vbYes) Then
Lastrow = Range("D" & Rows.Count).End(xlUp).Row
For Each Cell In Range("D2:D" & Lastrow)
On Error Resume Next
ThisWorkbook.FollowHyperlink "C:\Cut Sheets NEW\" & Cell.Value & ".pdf"
If Err.Number Then Cell.Interior.ColorIndex = 4
On Error GoTo 0
Next Cell
End If
End Sub

(Untested) Try adding the line of code I show in red above (in the location I show) and see if that does what you want.

 

[GormanRupp]

This is EXACTLY what i was looking for! Thank you very much for your help, it is greatly appreciated! 100% Satisfaction