This should work if you have your files in the sheet in column A, starting
in row 1.
Just alter this line of code:
arr1 = Range(Cells(1), Cells(52, 1))
And of course the search parameters.
Sub FindNonMatching()
Dim i As Long
Dim arr1
Dim arr2
Dim lFileCount As Long
Dim lDirCount As Long
Dim coll As Collection
Set coll = New Collection
'list of files in the sheet
arr1 = Range(Cells(1), Cells(52, 1))
'files from the folder
arr2 = FindFiles("C:\Test\", _
"*.xls", _
False, _
lFileCount, _
lDirCount)
'files found in folder to collection
For i = 1 To UBound(arr2)
coll.Add i, arr2(i)
Next i
'find the non-matching files and mark the cells
On Error Resume Next
For i = 1 To UBound(arr1)
coll.Add i, arr1(i, 1)
If Err.Number = 0 Then
Cells(i, 1).Interior.ColorIndex = 20
Else
Err.Clear
End If
Next i
End Sub
Function FindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean, _
Optional lFileCount As Long, _
Optional lDirCount As Long) As String()
'will produce a 1-based 1-D array with all the found filepaths
'---------------------------------------------------------------
'adapted from the MS example:
'
http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------
Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Long 'Number of directories in this strPath.
Dim i As Long
Static strStartDirName As String
Static collFiles As Collection
Dim arrFinal
On Error GoTo sysFileERR
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
If lFileCount = 0 And lDirCount = 0 Then
strStartDirName = strPath
Set collFiles = New Collection
End If
'Search for subdirectories.
nDir = 0
ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so on.
Do While Len(strDirName) > 0
'Ignore the current and encompassing directories.
If (strDirName <> ".") And (strDirName <> "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop
'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)
While Len(strFileName) <> 0
lFileCount = lFileCount + 1
collFiles.Add Item:=strPath & strFileName, Key:=CStr(lFileCount)
strFileName = Dir() 'Get next file.
Wend
If bSubFolders Then
'If there are sub-directories..
If nDir > 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSubFolders, _
lFileCount, _
lDirCount
Next
End If
'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
'change the collection to an array
'---------------------------------
ReDim arrFinal(1 To lFileCount) As String
For i = 1 To lFileCount
arrFinal(i) = collFiles(i)
Next
FindFiles = arrFinal
End If
Else
ReDim arrFinal(1 To lFileCount) As String
For i = 1 To lFileCount
arrFinal(i) = collFiles(i)
Next
FindFiles = arrFinal
End If
ABORTFUNCTION:
Exit Function
sysFileERR:
If Right$(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
Resume ABORTFUNCTION
End If
End Function
RBS
hi all, I have file names in column A and I want macro which should
match these file names with the files in folder "C:\Document" and if
there is any file name which don’t match then macro should highligt
that cell.
