Search and list in a new worksheet 3 cells from up to 1000spreadsheets

M

Mel

I have just over 1000 spreadsheets (retro salary calculations) where I
need to find all the sheets that have more than $3,000 in cell K47 on
tab called 'RETRO'. (I have other folders that I would need to search
for not on same server so would need to set up this macro in a
spreadsheet that could be shared with my users to do a search on their
files as well).

The macro would run and will allow me to change the search criteria -
amount (ie. $4,000 or $5,000), also change the location of where the
spreadsheets to search for are.

The folder where the spreadsheets will be locatged may have sub
folders which I would also like to search in but am not sure of the
coding to get the search to perform in all folders and subfolders.

The spreadsheet I will be searching in has 5 tabs. The 4th Tab is
called 'RETRO' and is the tab that has the info in it I want. Cell
K47 has the target data. If I find any spreadsheet with $3,000 (or
what I specify) or more we then need to copy to a new spreadsheet
called 'AUDIT' and copy cells (from the retro tab) E2, I2, K2 and K47
to this new spreadsheet.

I have this so far:

Sub OpenAFile()
Dim vfilename As String, FindMe As String
Dim myBk As Workbook
Const Message As String = "Enter Search amount:"
Const Title As String = "Dollar Search"
FindMe = InputBox(Message, Title)
If FindMe = vbNullString Then
****MsgBox "No Search amount listed.**Please enter an amount to search
for and try again", _
********, "Search Result"
****Exit Sub
End If

thanks

Mel
 
B

Barb Reinhardt

Would they be searching within a folder or would they need to dig into
subfolders?
 
P

Patrick Molloy

I don't know if the replies you had worked or not.

If not, tryu this - you'll need to paste the code into a standard module and
then using Tools/references add a reference to Microsoft Scripting Runtime

Option Explicit
Dim processed As Long
Sub Main()
Dim sName As String
Dim sFolder As Scripting.Folder
sName = Dir("E:\Excel\*.*")
processed = 0
With New Scripting.FileSystemObject

processfolders .GetFolder("E:\Excel")
End With
MsgBox processed & " files"
End Sub
Sub processfolders(sFolders As Scripting.Folder)
Dim sFolder As Scripting.Folder
Dim sFile As Scripting.File
For Each sFolder In sFolders.SubFolders
processfolders sFolder
Next
For Each sFile In sFolders.Files
processed = processed + 1
DoWhatever sFile.Path & "\" & sFile.Name
Cells(processed, 1) = sFolders.Name
Cells(processed, 2) = sFile.Name
Next

End Sub
Sub DoWhatever(sFileName As String)
Dim wb As Workbook
Set wb = Workbooks.Open(sFileName)
'serach here
wb.Close False
Set wb = Nothing
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top