Looping over Hyperlink cells

Question

Hi I have a sheet containig hyperlinks to pdf files in C-Drive. some files have been moved. hyperlinks are not more working. I would like to know witch likns are not working so I can later correct the hyperlink. File name are listes in column A, hypelins in Col C. Bellow program is stoping abter the first loop. Any help please

Sub OpenHyperlink() ' Dim fileopen As String Dim ColDimension As Long Dim Counter Dim DynamicFileHyperlink As String Dim FileLink As String

ColDimension = Range("B2", Range("B2").End(xlDown)).Cells.Count

For Counter = 1 To ColDimension fileopen = Range("B2").Offset(Counter - 1, 0).Value

On Error GoTo 10

Range("B2").Offset(Counter - 1, 0).Activate
Range("B2").Hyperlinks(Counter).Follow

    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Hyperlink OK"
    
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent3
    .TintAndShade = 0.599993896298105
    .PatternTintAndShade = 0
End With
  
    GoTo 20

10 Range("B2").Offset(Counter - 1, 0).Activate Debug.Print "File not found: " + fileopen

   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = "Hyperlink Not OK"
   
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 255
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

        GoTo 30

20 Debug.Print "File found hyperlink OK : " + fileopen

30 ' Next Counter

End Sub

Hi I have a sheet containig hyperlinks to pdf files in C-Drive. some files have been moved. hyperlinks are not more working. I would like to know witch likns are not working so I can later correct the hyperlink. File name are listes in column A, hypelins in Col C. Bellow program is stoping abter the first loop. Any help please