Mark,
I THINK I understand what you're after. I'm assuming that all your data is
in row 1, and is laid out like the following, starting in column D:
User1 File1 User2 File2 User3 Files3 TOTAL NNN
In the example data above, the values are across columns D:K
Run the following code:
Sub AAA()
Dim FilesInDir As New Collection
Dim FilesOnSheet As New Collection
Const C_FOLDER = "C:\Temp" '<<< CHANGE
Dim Rng As Range
Dim LastCol As Long
Dim WS As Worksheet
Dim Ndx As Long
Dim SaveDir As String
Dim FName As String
Dim S As String
SaveDir = CurDir
ChDrive C_FOLDER
ChDir C_FOLDER
FName = Dir("*.xls", vbNormal + vbSystem + vbHidden)
''''''''''''''''''''''''''''''''''''''''
' Loop through each worksheet.
''''''''''''''''''''''''''''''''''''''''
For Each WS In ActiveWorkbook.Worksheets
'''''''''''''''''''''''''''''''''''''
' Reset the collections.
'''''''''''''''''''''''''''''''''''''
Set FilesOnSheet = Nothing
Set FilesInDir = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Load up all the file names in the folder
' C_FOLDER into the FilesInDir collection.
''''''''''''''''''''''''''''''''''''''''''''''''''''
Do Until FName = vbNullString
FilesInDir.Add FName, CurDir & "\" & FName
FName = Dir()
Loop
''''''''''''''''''''''''''''''''''''''''
' Find the last cell in row 1
''''''''''''''''''''''''''''''''''''''''
LastCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column
If LastCol > 1 Then
'''''''''''''''''''''''''''''''''''''''''''''
' If LastCol > 1, there is data in row 1.
' Loop through the cells in row 1, starting
' at LastCol - 2, right-to-left, stepping
' in incrments of -2. This loop will
' get each filename on row 1.
'''''''''''''''''''''''''''''''''''''''''''''
For Ndx = LastCol - 2 To 4 Step -2
''''''''''''''''''''''''''''''''''''''''''''''
' Loop through row 1, looking at the files.
''''''''''''''''''''''''''''''''''''''''''''''
Err.Clear
''''''''''''''''''''''''''''''''''
' Get the filename from the sheet.
''''''''''''''''''''''''''''''''''
FName = WS.Cells(1, Ndx)
'''''''''''''''''''''''''''''''''
' Add FName to the FilesOnSheet
' collection.
'''''''''''''''''''''''''''''''''
FilesOnSheet.Add FName, FName
If Err.Number Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This condition indicates that FName appears more than
' once in row 1.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MsgBox "The filename: '" & FName & "' is already in use."
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Remove FName from FilesInDir. If all is right with the world
' this collection will be emptied out by the end of the loop.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Err.Clear
FilesInDir.Remove FName
If Err.Number Then
MsgBox "There is a file on the sheet that is not in" &
vbCrLf & _
"the folder: " & C_FOLDER
Exit Sub
End If
Next Ndx
If FilesInDir.Count = 0 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If FilesInDir.Count = 0, we have deleted from the
' FilesInDir collection all the files that are in
' Row 1. This means that every user in row 1
' has his own assigned file name, and that there
' are no files in C_FOLDER that were not named
' in rows 1. This condition indicates success.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''
' YOUR CODE HERE
MsgBox "Your Code Here"
''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''
Else
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If FilesInDir.Count = 0, there were files in the folder
' C_FOLDER that were not used on the worksheet. List these.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Ndx = 1 To FilesInDir.Count
S = S & FilesInDir(Ndx) & vbCrLf
Next Ndx
MsgBox "The following files are in the directory" & vbCrLf & _
"but not used on the sheet." & vbCrLf & S
Exit Sub
End If
End If
Next WS
ChDrive SaveDir
ChDir SaveDir
End Sub
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)