Search & extract from multiple workbooks
 

I have over 20 workbooks (each with several worksheets), that I would like to
search for the character string "03-", and when it is found, copy the entire
row it is in into a separate workbook. None of the workbooks are exactly the
same, so I need to scan the entire book, including each sheet.

If I need to run a search and create a new worksheet in each file to capture
the results, then pull each new worksheet into a new workbook, I can do that.

I am using Excel 2003, not good with VBA creation but familiar with general
programming syntax. Can anyone help?

Thanks,
Ann

Search & extract from multiple workbooks
 

Sub copyData()
dim sh as Worksheet, sh1 as Worksheet
Dim rng as Range, rng1 as Range
dim fName as String
Dim sAddr as String
Dim bk as Workbook

' sheet to copy data to:
set sh1 = thisworkbook.Worksheets("Sheet1")

fName = Dir("C:\MyFolder\*.xls")
do while fName < ""
set bk = Workbooks.Open("C:\Myfolder\" & fName)
for each sh in bk.Worksheets
set rng = sh.Cells.Find("03-*", Lookin:=xlValues, _
Lookat:=xlWhole,MatchCase:=False)
if not rng is nothing then
sAddr = rng.Address
do
set rng1 =sh1.Cells(rows.count,1).End(xlup)(2)
rng.EntireRow.copy Destination:=rng1
if isempty(rng1) then rng1.Value = "ZZZZXXX"
set rng = sh.Cells.FindNext(rng)
Loop rng.Address < sAddr
end if
Next sh
fName = Dir()
Loop
End Sub


Would be a start.
Code is untested and may contain typos, but should be close.
Assumes all the workbooks are in a single directory and you want to process
all workbooks in that directory.



--
Regards,
Tom Ogilvy


"Ann" wrote in message
...
I have over 20 workbooks (each with several worksheets), that I would like
to
search for the character string "03-", and when it is found, copy the
entire
row it is in into a separate workbook. None of the workbooks are exactly
the
same, so I need to scan the entire book, including each sheet.

If I need to run a search and create a new worksheet in each file to
capture
the results, then pull each new worksheet into a new workbook, I can do
that.

I am using Excel 2003, not good with VBA creation but familiar with
general
programming syntax. Can anyone help?

Thanks,
Ann

Search & extract from multiple workbooks
 

I am getting a "Compile Error: syntax error" for this line:
Loop rng.Address < sAddr

Otherwise, should work ok, all workbooks are in the same directory and I
want to search all of them.

Any help? What am I missing?

Thanks,
Ann

Search & extract from multiple workbooks
 

Loop while rng.Address < sAddr

--
Regards,
Tom Ogilvy

"Ann" wrote in message
...
I am getting a "Compile Error: syntax error" for this line:
Loop rng.Address < sAddr

Otherwise, should work ok, all workbooks are in the same directory and I
want to search all of them.

Any help? What am I missing?

Thanks,
Ann

Search & extract from multiple workbooks
 

You probably don't want all the workbooks open at the end either, so I added
a line:

Sub copyData()
Dim sh As Worksheet, sh1 As Worksheet
Dim rng As Range, rng1 As Range
Dim fName As String
Dim sAddr As String
Dim bk As Workbook

' sheet to copy data to:
Set sh1 = ThisWorkbook.Worksheets("Sheet1")

fName = Dir("C:\MyFolder\*.xls")
Do While fName < ""
Set bk = Workbooks.Open("C:\Myfolder\" & fName)
For Each sh In bk.Worksheets
Set rng = sh.Cells.Find("03-*", LookIn:=xlValues, _
Lookat:=xlWhole, MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
Set rng1 = sh1.Cells(Rows.Count, 1).End(xlUp)(2)
rng.EntireRow.Copy Destination:=rng1
If IsEmpty(rng1) Then rng1.Value = "ZZZZXXX"
Set rng = sh.Cells.FindNext(rng)
Loop While rng.Address < sAddr
End If
Next sh
' added line to close workbook
bk.Close Savechanges:=False
fName = Dir()
Loop
End Sub

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
Loop while rng.Address < sAddr

--
Regards,
Tom Ogilvy

"Ann" wrote in message
...
I am getting a "Compile Error: syntax error" for this line:
Loop rng.Address < sAddr

Otherwise, should work ok, all workbooks are in the same directory and I
want to search all of them.

Any help? What am I missing?

Thanks,
Ann

Search & extract from multiple workbooks
 

Works like a charm!

One other thing, more convenience than anything, is there a way to have it
add the originating file name to the row of data it returns?

Such as:
"FileOne.xls" "03-54345"

Thanks so much!

"Tom Ogilvy" wrote:

Loop while rng.Address < sAddr

--
Regards,
Tom Ogilvy

"Ann" wrote in message
...
I am getting a "Compile Error: syntax error" for this line:
Loop rng.Address < sAddr

Otherwise, should work ok, all workbooks are in the same directory and I
want to search all of them.

Any help? What am I missing?

Thanks,
Ann

Search & extract from multiple workbooks
 

Sub copyData()
Dim sh As Worksheet, sh1 As Worksheet
Dim rng As Range, rng1 As Range
Dim fName As String
Dim sAddr As String
Dim bk As Workbook

' sheet to copy data to:
Set sh1 = ThisWorkbook.Worksheets("Sheet1")

fName = Dir("C:\MyFolder\*.xls")
Do While fName < ""
Set bk = Workbooks.Open("C:\Myfolder\" & fName)
For Each sh In bk.Worksheets
Set rng = sh.Cells.Find("03-*", LookIn:=xlValues, _
Lookat:=xlWhole, MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
Set rng1 = sh1.Cells(Rows.Count, 1).End(xlUp)(2)
rng.EntireRow.Copy Destination:=rng1
rng1.Insert Shift:=xlShifttoRight
' uncomment to get sheet name too
rng1.Offset(0,-1).Value = bk.Name ' & "!" & rng.Parent.Name
Set rng = sh.Cells.FindNext(rng)
Loop While rng.Address < sAddr
End If
Next sh
' added line to close workbook
bk.Close Savechanges:=False
fName = Dir()
Loop
End Sub

--
Regards,
Tom Ogilvy



"Ann" wrote in message
...
Works like a charm!

One other thing, more convenience than anything, is there a way to have it
add the originating file name to the row of data it returns?

Such as:
"FileOne.xls" "03-54345"

Thanks so much!

"Tom Ogilvy" wrote:

Loop while rng.Address < sAddr

--
Regards,
Tom Ogilvy

"Ann" wrote in message
...
I am getting a "Compile Error: syntax error" for this line:
Loop rng.Address < sAddr

Otherwise, should work ok, all workbooks are in the same directory and
I
want to search all of them.

Any help? What am I missing?

Thanks,
Ann