Perhaps I need to clarify a little bit more about my previous question. As I already have a list of the match file names that exist in a directory, I'd like to open only those files with the extension .xls only.
Next, for everyfile, I'd like to perform some checking on every 1st sheet("CoverPage") and 2nd sheet("TableOfContents"). FYI, these two sheet names will be all the same for all files.
As for your questions, my answers would be as follow:
Q: what do you mean by check the 1st sheet and the 2nd sheet. do you mean you want to check if they exist? - Yes, while prompt the user an error message if the sheet does not exist.
do you want to check some value on the sheet - Yes, but if only both sheets exist; then proceed with checking certain values on both sheets, otherwise exit.
based on what you mean by check, then what is the action if the check is successful. What is the action if the check is unsuccessful. -For the checking part, I'd like to check to see if the revision number on "CoverPage" sheet is in sync with the latest revision number in the "TableOfContents" sheet.
In other words, the revision number on cover page sheet (Range (B9:R10)) will be compared to the latest revision number in "TableOfContents" sheet; which indicated by the last row in column "B".
If they are found to be in sync, the cell next to the file name column (in the "FileList3" sheet) will be checked as 'Yes' otherwise as 'No'.
is this done as part of the original macro? - I thought it would be easier to open and check the match files as I list the file names from a directory, but I do not know how to incorporate them in your code.
And if you find it will be easier to do it in different macros (match and sort the file names first) and then create another macro to open and check the match files (.xls files only), then it's fine by me. Which ever way that works.
I need you help again in VBA solution. Thank you again in advance.
You say in sheet coverpage that the revision number is in the Range(B9:R10). That is a big range. so to determine the current revision number, I loop through the range going from B9:R9, then from B10:R10 and each time I find a value in a cell, I assign that to the revnum variable. so after looping through that range, revnum should have the value of the last cell found (going in that order) that has a value in it. I assume that is the revision number.
I then go to Tableofcontents sheet and find the last value in column B. I then compare that cells value with the value in RevNum and if they match, I put in a Yes in column E next to the filename or I put a No in if they do not match. If a file does not have a yes or no next to it, then if the file is anfile, it means it doesn't have one or both of the worksheets with names of Coverpage/Tableofcontents.
Here is the revised macro. It worked for me:
Option Explicit Dim lgcurrRow As Long Dim saFileList() As String Dim saPathList() As String
Sub putlistinArray3_Checkfiles() Dim spath As String, sName As String Dim v As Variant, icnt As Long, icnt1 As Long, v1 As Variant Dim sh As Worksheet, r As Range, i As Long, j As Long Dim jj As Long, bFound As Boolean, r1 As Range, iloc As Long Dim cell As Range, v2 As Variant, v3 As Variant, vv As Variant Dim bk As Workbook, sh1 As Worksheet, sh2 As Worksheet Dim cell1 As Range, r1a As Range, r2a As Range, revnum As Variant Dim ss As String Set sh = Worksheets("FileList3") spath = sh.Range("C11") If Right(spath, 1) <> "\" Then spath = spath & "\" sName = Dir(spath & "*.*") '<== gets all files regardless of extension 'icnt = 0 'Do While sName <> "" ' icnt = icnt + 1
'iloc = InStr(1, sName, ".", vbTextCompare) 'If iloc > 0 Then sName = Left(sName, iloc - 1)
' v(icnt) = sName ' sName = Dir 'Loop ReDim saFileList(1 To 1) ReDim saPathList(1 To 1) luke_Linkwalker szPath:=spath, icnt:=0 v = saFileList vv = saPathList icnt = UBound(saFileList) ' assume list you want to compare against starts in A17 ' change it if it is another cell Set r = sh.Range("B20", sh.Cells(sh.Rows.Count, "B").End(xlUp)) v1 = r.Value ReDim v2(1 To UBound(v1), 1 To 1) ReDim v3(1 To UBound(v1), 1 To 1) For i = 1 To UBound(v1, 1)
bFound = False For j = 1 To icnt If InStr(1, v(j), v1(i, 1), vbTextCompare) Then bFound = True jj = j Exit For End If Next If Not bFound Then v1(i, 1) = Empty v2(i, 1) = Empty v3(i, 1) = Empty Else v1(i, 1) = v(jj) v2(i, 1) = vv(jj) v(jj) = Empty vv(jj) = Empty End If
Next ReDim Preserve v(1 To icnt) ReDim Preserve vv(1 To icnt) For i = 1 To icnt - 1
If IsEmpty(v(i)) Then j = i + 1 Do While IsEmpty(v(j)) And j < icnt j = j + 1 If j > icnt Then Exit Do Loop If j <= icnt Then v(i) = v(j) vv(i) = vv(j) v(j) = Empty vv(j) = Empty icnt1 = i End If Else icnt1 = i End If
Next i ReDim Preserve v(1 To icnt1) ReDim Preserve vv(1 To icnt1)
r.Offset(0, 2).Value = v1 ' code to check workbooks For i = 1 To UBound(v1, 1)
Set bk = Nothing Set sh1 = Nothing Set sh2 = Nothing If Not IsEmpty(v1(i, 1)) Then If InStr(1, v1(i, 1), ".xl", vbTextCompare) Then ss = v2(i, 1) & v1(i, 1) Set bk = Workbooks.Open(ss) On Error Resume Next Set sh1 = bk.Worksheets("CoverPage") Set sh2 = bk.Worksheets("TableOfContents") On Error GoTo 0 If Not sh1 Is Nothing Then ' Debug.Print sh1.Name, bk.Name If Not sh2 Is Nothing Then ' Debug.Print sh2.Name, bk.Name Set r1a = sh1.Range("B9:R10") Set r2a = sh2.Cells(sh2.Rows.Count, "B").End(xlUp) For Each cell1 In r1a If Len(Trim(cell1)) > 0 Then revnum = cell1 End If Next ' Debug.Print revnum, r2a.Address, r2a.Value If revnum = r2a.Value Then v3(i, 1) = "Yes" Else v3(i, 1) = "No" End If End If End If bk.Close Savechanges:=False End If End If
Next ' end of code to check workbooks r.Offset(0, 3).Value = v3 For Each cell In r.Offset(0, 2)
If Len(Trim(cell)) = 0 Then cell.EntireRow.Interior.ColorIndex = 15 End If
Next End Sub
Public Sub luke_Linkwalker(szPath As String, _ icnt As Long) Dim saDirList() As String Dim szNewPath As String Dim szFname As String Dim i As Long, j As Long
ReDim saDirList(1 To 1) 'Debug.Print szPath saDirList(1) = "" 'saFileList(1) = "" szFname = Dir(szPath, vbDirectory) ' Retrieve the first entry. i = 0 j = icnt Do While szFname <> "" ' Start the loop. ' Ignore the current directory and 'the encompassing directory. If szFname <> "." And szFname <> ".." Then
' Use bitwise comparison to make sure ' szFname is a directory.
If (GetAttr(szPath & szFname) And vbDirectory) = _ vbDirectory Then ' get entry only if it is directory i = i + 1 ReDim Preserve saDirList(1 To i) saDirList(i) = szFname Else ' ^Directories j = j + 1 ReDim Preserve saFileList(1 To j) ReDim Preserve saPathList(1 To j) saFileList(j) = szFname saPathList(j) = szPath End If
End If szFname = Dir ' Get next entry. Loop
'Debug.Print szPath & " " & _ ' LBound(saFileList) & " " & UBound(saFileList) & " " & _ ' LBound(saDirList) & " " & UBound(saDirList)
If Len(saDirList(1)) > 0 Then For i = LBound(saDirList) To UBound(saDirList)
szNewPath = szPath & saDirList(i) & "\"
' Debug.Print szNewPath, UBound(saFileList)
luke_Linkwalker szPath:=szNewPath, icnt:=UBound(saFileList)
Next i End If End Sub
Note that the macro could take a while if it has to open a lot of files.