File name extraction w/hyperlinks no duplicates.

Hi,

Option Explicit

Private Sub CommandButton1_Click()
Dim rngSave As Range
Dim lngCount As Long
Dim strPathFile As String
Dim strFname As String
Dim intLastDiv As Integer
Dim n As Integer

Dim xlRng As Range
Dim strPath As String
Dim strFileName As String
Dim strFirstAddr As String
Dim blnDuplicate As Boolean

'On Error GoTo ErrHnd

    With ActiveSheet
        'find the last used cell in column A
        Set rngSave = .Range("A" & .Range("A65534").End(xlUp).Row + 1) 'otherwise you are overwriting the last row
        
        ' Open the file dialog
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = True
            .Show
        End With
        
        'Copy all path/filenames into column A
        For lngCount = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
            
            strPathFile = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(lngCount)
            intLastDiv = InStrRev(strPathFile, "\") 'faster
            strPath = Left(strPathFile, intLastDiv)
            strFileName = Right(strPathFile, Len(strPathFile) - intLastDiv)
            
            blnDuplicate = False
            Set xlRng = .Columns(2).Find(what:=strFileName, LookIn:=xlValues, lookat:=xlWhole)
            If Not xlRng Is Nothing Then
                strFirstAddr = xlRng.Address
                Do
                    If .Range("A" & xlRng.Row).Value = strPath Then
                        blnDuplicate = True
                        Exit Do
                    End If
                    
                    Set xlRng = .Columns(2).FindNext(After:=xlRng)
                Loop Until xlRng Is Nothing Or xlRng.Address = strFirstAddr
            End If

            If Not blnDuplicate Then
                'save path in column A
                rngSave.Offset(lngCount - 1, 0).Value = strPath
                'save filename in column B
'                rngSave.Offset(lngCount - 1, 1).Value = strFileName
                'hyperlink
                .Hyperlinks.Add Anchor:=rngSave.Offset(lngCount - 1, 1), _
                    Address:=strPath & "\" & strFileName, _
                    TextToDisplay:=strFileName
            End If
            
        Next lngCount
 
        'set column widths to fit
        .Range("A1:B" & rngSave.Row + lngCount).Columns.AutoFit
    End With
    Exit Sub

'error handler
ErrHnd:

Err.Clear
End Sub