Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub makeLinks()
Dim rng As Range
Dim lngLast As Long, lngLastCol As Long
Dim strPath As String, strlink As String
strPath = ThisWorkbook.Path & "\"
lngLast = Application.Max(16, Cells(Rows.Count, 23).End(xlUp).Row)
lngLastCol = 44
Me.Unprotect "sperl"
For Each rng In Range(Cells(17, 24), Cells(lngLast, lngLastCol)).SpecialCells(xlCellTypeConstants)
If IsNumeric(rng) Then
If rng < 99 Then
strlink = Cells(rng.Row, 1).MergeArea.Cells(1, 3).Text & _
Cells(rng.Row, 4).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 5).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 6).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 7).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 8).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 9).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 10).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 11).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 12).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 13).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 14).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 15).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 16).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 17).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 18).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 19).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 21).MergeArea.Cells(1, 1).Text & _
Cells(rng.Row, 23).Text & rng.Text
If MakeSureDirectoryPathExists(strPath & strlink & "\") <> 0 Then
Me.Hyperlinks.Add rng, strPath & strlink
End If
End If
End If
Next
Me.Protect Password:="sperl"
End Sub