try:
Sub Search_myFolder_Network()
    Dim myFolder As String
    Dim myRange As Range, colFiles As New Collection
    Dim arrNames() As Variant, arrMsg, r As Long, msg As String, nm, fName
    Dim cel As Range
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = Application.DefaultFilePath & "\"
        If .Show = 0 Then Exit Sub
        myFolder = .SelectedItems(1)
    End With
    
    
    Call RecursiveDir(colFiles, myFolder, "*.*", True)
    
    ReDim arrNames(1 To colFiles.Count)
    
    Set myRange = Application.Selection
    'arrNames = myRange 'assumes one-column contiguous range is selected
    
    If IsEmpty(myRange) Then
        Debug.Print "Empty"
        Exit Sub
    End If
    
    For Each cel In myRange
        r = r + 1
    'For r = 0 To UBound(arrNames, 1)
        msg = "File not found"   'reset message
        'fName = arrNames(r, 1)
        fName = cel & ""
        If Len(fName) <> 0 Then
            For Each nm In colFiles  'loop over all found file names
                If InStr(1, nm, fName, vbTextCompare) > 0 Then
                    'msg = "File exists"
                    msg = "Found " & fName & " in " & Replace$(nm, fName, "")
                    Debug.Print msg
                    Exit For  'stop checking
                End If
            Next nm
            arrNames(r) = msg 'replace file name with result message
        End If
    Next cel
    
    myRange.Offset(0, 1).Value = arrNames  'write the results to the next column




End Sub


' arnelgp
Public Sub RecursiveDir(ByRef colFiles As Collection, _
                             ByVal strFolder As String, _
                             ByVal strFileSpec As String, _
                             Optional ByVal bIncludeSubfolders As Boolean = False)


    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant


    On Error Resume Next
    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop


    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop


        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If


End Sub




Private Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function