Multiple Workbooks

[clappouk]

Good Afternoon,

Am i trying to re-write the wheel, basically I am trying to do CTRL+F for 12 workbooks.

I have a folder that contains workbooks for each month of the year, from April 2011 to March 2012. Each workbook is used to track emails that come in from all over the country that relate to customers & their complaints. (customer has unique reference).

Is is possible for that when someone enters a client reference number into cell A2, a msg box would open and show a list of the previous complaints including which Work Book & A"Ref" of the clients reference number. Each office could have sent more than 1 email during each month regarding a cleint.

I know some basic looping within VBA, its getting to perform the loop to open each workbook, when the cell in column A is completed. And how do I get the loop to copy the Workbook name & Cell A"whatever" to a msgbox.


Any thoughts, bits of code would be appreciated.

Ray
Excel 2003

 

[Datsmart]

I put together some code that does part of what you are asking:

Sub Locate_Data()
Dim basebook As Workbook
Dim mybook As Workbook
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
Set basebook = ThisWorkbook
MyPath = "C:\~~~\Excel\Test2\Test2A"
'Assign file path
    ChDrive MyPath
    ChDir MyPath
'Assign variable for Item to Search for
    FItem = Cells(2, 1)
'Assign Filenames to Search
    FNames = Dir("*.xls")
        If Len(FNames) = 0 Then
            MsgBox "No files in the Directory"
            ChDrive SaveDriveDir
            ChDir SaveDriveDir
            Exit Sub
        End If
'Turn OFF ScreenUpdating
    Application.ScreenUpdating = False
'Assign Row Number to start
    rnum = 1
'Loop through Files
    Do While FNames <> ""
        Set mybook = Workbooks.Open(FNames)
        For Each ws In Worksheets
            With ws
                On Error Resume Next
                FindItem = Sheets(ws.Name).Cells.Find(What:=FItem).Address
                If FindItem <> "" Then
                    basebook.Sheets("Sheet2").Cells(rnum, "B").Value = mybook.Name
                    basebook.Sheets("Sheet2").Cells(rnum, "C").Value = ws.Name
                    basebook.Sheets("Sheet2").Cells(rnum, "D").Value = FindItem
                    rnum = rnum + 1
                    FindItem = Nothing
                End If
            End With
        Next ws
        mybook.Close False
        FNames = Dir()
    Loop
'Return to original Path
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
'Turn ON ScreenUpdating
    Application.ScreenUpdating = True
End Sub

This code searches for the value of cell A2 in all the Worksheets in all the Files in the Path listed in the code.
Rather than using a msgbox, it lists the FileName, WorkSheet Name and Cell Address of each FIND to the active worksheet starting in cell B1.
The code will only find the first match on each worksheet.

Hope this can be of some help.