Finding data in closed workbooks with VBA

[daithiboy]

Hi all,

I'm wondering if it is possible to scan through a number(15) of different closed workbooks (containing 1 worksheet each). if the value "Fail" is found anywhere in the workbooks I would like to copy the entire row and paste it into the active worksheet, called "Summary". I have manipulated the following code (found online) to work if the sources and destination are in the same workbook:

[SIZE=2]Sub Summary()[/SIZE]
[SIZE=2]
[/SIZE]
[SIZE=2]Dim strArray As Variant[/SIZE]
[SIZE=2]Dim wsSource As Worksheet[/SIZE]
[SIZE=2]Dim wsDest As Worksheet[/SIZE]
[SIZE=2]Dim NoRows As Long[/SIZE]
[SIZE=2]Dim DestNoRows As Long[/SIZE]
[SIZE=2]Dim I As Long[/SIZE]
[SIZE=2]Dim J As Integer[/SIZE]
[SIZE=2]Dim rngCells As Range[/SIZE]
[SIZE=2]Dim rngFind As Range[/SIZE]
[SIZE=2]Dim Found As Boolean[/SIZE]
[SIZE=2]
[/SIZE]
[SIZE=2]    strArray = Array("Fail Non Risk", "Fail Risk", "Fail")[/SIZE]

[SIZE=2]    Set wsSource = Sheet2[/SIZE]

[SIZE=2]    NoRows = wsSource.Range("A65536").End(xlUp).Row[/SIZE]
[SIZE=2]    DestNoRows = 3[/SIZE]
[SIZE=2]    Set wsDest = Sheet9[/SIZE]

[SIZE=2]    For I = 1 To NoRows[/SIZE]

[SIZE=2]        Set rngCells = wsSource.Range("e" & I & ":h" & I)[/SIZE]
[SIZE=2]        Found = False[/SIZE]
[SIZE=2]        For J = 0 To UBound(strArray)[/SIZE]
[SIZE=2]            Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)[/SIZE]
[SIZE=2]        Next J[/SIZE]

[SIZE=2]        If Found Then[/SIZE]
[SIZE=2]            rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)[/SIZE]

[SIZE=2]            DestNoRows = DestNoRows + 1[/SIZE]
[SIZE=2]        End If[/SIZE]
[SIZE=2]    Next I[/SIZE]

[SIZE=2]End Sub[/SIZE]

My issue now is that I have not got a clue how to develop this code to open each workbook(all in the same directory), find the "Fail", copy and paste it to the destination and close each workbook when finished.

I did find the following code which seems to be along the right lines but I have no idea to merge this with the code above.

[COLOR=#660066]Sub[/COLOR][COLOR=#660066]ReadDataFromAllWorkbooksInFolder[/COLOR][COLOR=#666600]()[/COLOR][COLOR=#000000]
[/COLOR][COLOR=#660066]Dim[/COLOR][COLOR=#660066]FolderName[/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]String[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] wbName [/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]String[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] r [/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]Long[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] cValue [/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]Variant[/COLOR][COLOR=#000000]
[/COLOR][COLOR=#660066]Dim[/COLOR][COLOR=#000000] wbList[/COLOR][COLOR=#666600]()[/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]String[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] wbCount [/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]Integer[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] i [/COLOR][COLOR=#660066]As[/COLOR][COLOR=#660066]Integer[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#660066]FolderName[/COLOR][COLOR=#666600]=[/COLOR][COLOR=#008800]"D:\testing"[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#008800]' create list of workbooks in foldername'[/COLOR][COLOR=#666600]---[/COLOR][COLOR=#660066]Comment[/COLOR][COLOR=#000000]
    wbCount [/COLOR][COLOR=#666600]=[/COLOR][COLOR=#006666]0[/COLOR][COLOR=#000000]
    wbName [/COLOR][COLOR=#666600]=[/COLOR][COLOR=#660066]Dir[/COLOR][COLOR=#666600]([/COLOR][COLOR=#660066]FolderName[/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#008800]"\" & "[/COLOR][COLOR=#666600]*.[/COLOR][COLOR=#000000]xls[/COLOR][COLOR=#008800]")""
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    ' get values from each workbook' --- Comment
    r = 0
    Workbooks.Add
    For i = 1 To wbCount
        r = r + 1
        cValue = GetInfoFromClosedFile(FolderName, wbList(i), "[/COLOR][COLOR=#660066]Sheet1[/COLOR][COLOR=#008800]", "[/COLOR][COLOR=#000000]A1[/COLOR][COLOR=#008800]")
        Cells(r, 1).Formula = wbList(i)
        Cells(r, 2).Formula = cValue
    Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
    wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "[/COLOR][COLOR=#000000]\" [/COLOR][COLOR=#660066]Then[/COLOR][COLOR=#000000] wbPath [/COLOR][COLOR=#666600]=[/COLOR][COLOR=#000000] wbPath [/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#008800]"\"
    If Dir(wbPath & "[/COLOR][COLOR=#000000]\" [/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#000000] wbName[/COLOR][COLOR=#666600])[/COLOR][COLOR=#666600]=[/COLOR][COLOR=#008800]""[/COLOR][COLOR=#660066]Then[/COLOR][COLOR=#660066]Exit[/COLOR][COLOR=#660066]Function[/COLOR][COLOR=#000000]
    arg [/COLOR][COLOR=#666600]=[/COLOR][COLOR=#008800]"'"[/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#000000] wbPath [/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#008800]"["[/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#000000] wbName [/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#008800]"]"[/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#000000] _
        wsName [/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#008800]"'!"[/COLOR][COLOR=#666600]&[/COLOR][COLOR=#000000]amp[/COLOR][COLOR=#666600];[/COLOR][COLOR=#660066]Range[/COLOR][COLOR=#666600]([/COLOR][COLOR=#000000]cellRef[/COLOR][COLOR=#666600]).[/COLOR][COLOR=#660066]Address[/COLOR][COLOR=#666600]([/COLOR][COLOR=#000088]True[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000088]True[/COLOR][COLOR=#666600],[/COLOR][COLOR=#000000] xlR1C1[/COLOR][COLOR=#666600])[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#660066]On[/COLOR][COLOR=#660066]Error[/COLOR][COLOR=#660066]Resume[/COLOR][COLOR=#660066]Next[/COLOR][COLOR=#000000]
    [/COLOR][COLOR=#660066]GetInfoFromClosedFile[/COLOR][COLOR=#666600]=[/COLOR][COLOR=#660066]ExecuteExcel4Macro[/COLOR][COLOR=#666600]([/COLOR][COLOR=#000000]arg[/COLOR][COLOR=#666600])[/COLOR][COLOR=#000000]
[/COLOR][COLOR=#660066]End[/COLOR][COLOR=#660066]Function[/COLOR]

I hope one of you amazing people can help me as this is the final hurdle in this project!!

I am using Excel 2007 on a Windows PC.

Dave

 

[tonyyy]

Dave,

You might give the following a try...

Sub LoopThroughFiles()
'''''   Place this macro workbook in the same folder as your project files
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean
Dim wb As Workbook, wb0 As Workbook
Dim directory As String, fileName As String

directory = ThisWorkbook.Path & "\"
fileName = Dir(directory & "*.xls?")
Set wb0 = ThisWorkbook
strArray = Array("Fail Non Risk", "Fail Risk", "Fail")
Set wsDest = wb0.Sheets("Sheet9")

Do While fileName <> ""
    Set wb = Workbooks.Open(directory & fileName)
    Set wsSource = wb.Sheets(1)
    NoRows = wsSource.Range("A65536").End(xlUp).Row
    For I = 1 To NoRows
        DestNoRows = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Set rngCells = wsSource.Range("e" & I & ":h" & I)
        Found = False
        For J = 0 To UBound(strArray)
            Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
        Next J
        If Found Then
            rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
        End If
    Next I
    wb.Close savechanges:=False
    fileName = Dir
Loop
End Sub

The code is untested. And I tried to leave as much of your original code intact.

Cheers,

tonyyy

 

[daithiboy]

That is fantastic Tony. Thank you.

I have one slight change I would like to make and I hope you can help.

Instead of a normal paste, I would like to paste Special the values. I am trying to figure out where I can change this but there is nothing obvious, to me, there which is the paste command??

 

[tonyyy]

If Found Then
    rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
End If

While in the VBE, highlight the word "Copy" and press F1 for Help. You'll see the Paste function is implied when specifying the destination.

For help with PasteSpecial, type the function into the VBE, highlight it and press F1, and you'll see the proper syntax for the command.

 

[daithiboy]

Invaluable information Tony. Thank you.

 

[tonyyy]

You're welcome, daithiboy. Glad it worked out...