Openfiles from the existing list.

Question

.

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.

Best Jane

Answer

Jane,

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.