Excel Forum

Code: Select all

r = rg.Range("a" & Rows.Count).End(xlUp).Offset(0, 0).Row
For i = 1 To r
    If ActiveCell.Value = rg.Range("a" & i).Value Then
    ActiveWorkbook.FollowHyperlink (rg.Range("b" & i).Value)
    Exit Sub
    End If
Next i

Code: Select all

Sub gotolink()
    Dim draw As String
    Dim mb As Worksheet
    Dim mr As Ranges
    Dim rg As Worksheet
    Dim i As Long
    Dim r As Long
    Dim fN As String
    
    Set mb = Sheets("Sheet1")
    'Set mr = mb.Range("B:B")
    Set rg = Sheets("Path")
    
    r = rg.Range("a" & Rows.Count).End(xlUp).Row
    For i = 1 To r
'        If ActiveCell.Value = rg.Range("a" & i).Value Then
'            ActiveWorkbook.FollowHyperlink (rg.Range("b" & i).Value), UpdateLinks:=False
        fN = rg.Range("b" & i)
        Call OpenFile(fN)
'        Exit Sub
    Next i
ExitSub:
End Sub

Sub OpenFile(fileName As String)
    Dim fileNum As Integer
    Dim errNum As Integer
    
    On Error Resume Next
    fileNum = FreeFile()
    Open fileName For Input Lock Read As #fileNum
    Close fileNum
    errNum = Err
'    On Error GoTo 0

    Select Case errNum
        Case 0: IsFileOpen = False
            Workbooks.Open fileName, ReadOnly:=False
        Case 70: IsFileOpen = True
            Workbooks.Open fileName, ReadOnly:=True
        Case Else: MsgBox fileName & vbCrLf & _
            "Error " & errNum & ": " & Err.Description
    End Select
End Sub