I saw a macro you wrote for someone on how to search all spreadsheets in all workbooks in a dir for a string. This code is included below. I would like to do something very similar, however in a new workbook, i would like the macro to search through all worksheets in workbooks in the dir, for a string in the top of the new workbook. So after it finishes searching for the string in A1 and fills out the columns below it moves to B1.
Thank you for your time. Tim.
Sub loopfiles() Dim sName As String, sPath As String Dim sh As Worksheet, rw As Long, sh1 As Worksheet Dim bk As Workbook Set sh = ActiveSheet rw = 2 sPath = ThisWorkbook.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sName = Dir(sPath & "*.xls") Do While sName <> "" If LCase(sName) <> LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName) For Each sh1 In ActiveWorkbook.Worksheets If Application.CountIf(sh1.Cells, "*Amaranthus Sp*") > 0 Then ' the sheet contains "Amaranthus Sp" sh.Cells(rw, 1) = bk.Name sh.Cells(rw, 2) = sh1.Name rw = rw + 1 End If Next bk.Close SaveChanges:=False
End If sName = Dir() Loop End Sub
Tim,
Sub loopfiles() Dim sName As String, sPath As String Dim sh As Worksheet, rw As Long, sh1 As Worksheet Dim bk As Workbook, r As Range, cell As Range Set sh = ActiveSheet
sPath = ThisWorkbook.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set r = sh.Range("A1:Z1") ' list ofto lookup
rw = 4
For Each cell In r
sh.Cells(rw, 1).Value = "Word to find:" sh.Cells(rw, 2).Value = cell rw = rw + 1
sName = Dir(sPath & "*.xls") Do While sName <> "" If LCase(sName) <> LCase(ThisWorkbook.Name) Then Set bk = Workbooks.Open(sPath & sName) For Each sh1 In ActiveWorkbook.Worksheets
If Application.CountIf(sh1.Cells, "*" & cell.Text & "*") > 0 Then ' the sheet contains "Amaranthus Sp" sh.Cells(rw, 1) = bk.Name sh.Cells(rw, 2) = sh1.Name rw = rw + 1 End If
Next bk.Close SaveChanges:=False End If sName = Dir() Loop Next End Sub
Advertisement