View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson Jim Thomlinson is offline
external usenet poster
 
Posts: 5,939
Default Looping: Search Range in Multiple Selected Worksheets, Copy/P

Based on your description of the problem this should do it (or at least be
much closer). Just specify the paste column in Public Sub CopyAll().

Public Sub CopyAll()
Call CopyFromSheets("B", "this", "D")
Call CopyFromSheets("B", "that", "E")
Call CopyFromSheets("B", "the other", "F")
End Sub

Private Sub CopyFromSheets(ByVal strCol As String, _
ByVal strWhat As String, ByVal strPasteCol As String)
Dim wks As Worksheet
Dim rngFound As Range
Dim rngPaste As Range

Set rngPaste = Sheets("Summary").Cells(Rows.Count, _
strPasteCol).End(xlUp).Offset(1, 0)
For Each wks In Worksheets
On Error Resume Next
Set rngFound = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0
If Not rngFound Is Nothing Then
rngFound.Offset(0, 1).Copy rngPaste
Set rngFound = Nothing
End If
Set rngPaste = rngPaste.Offset(1, 0)
Next wks
End Sub

Private Function FindStuff(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String

Set rngFound = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound Is Nothing Then
Set FindStuff = Nothing
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
Set FindStuff = rngFoundAll
End If
End Function
.. --
HTH...

Jim Thomlinson


"ryguy7272" wrote:

Jim, this is so close!! Can I send you the file so you can see what I see?
My €˜Firm list populates fine and my €˜Stock Price list populates fine too.
These work because a specific value is identified (tab name for list of firms
and cell B2 in each worksheet). The code you posted here is great, but if
Excel cant find, for instance P/E on one worksheet, it will ignore the sheet
and populate the CURRENT cell with the NEXT P/E value that it finds. As soon
as Excel comes to a sheet that doesnt have a P/E, things really start to get
out of alignment. Also, the range continues to build down. For instance, as
the P/E array finishes, the P/S array starts, but it gets placed under the
P/E array; Excel doesnt know to shift over one column and start populating
the P/S data at the top of the P/S array.

This is so close to being finished!! I surmise it will just be another
couple of steps. Please send me your email (off the DG) and I will reply
with the model, and all VBA code. When I have this working 100% I will post
the code for the benefit of others.

Regards,
RyGuy---


--
RyGuy


"Jim Thomlinson" wrote:

Something like this should be close. In Public Sub CopyAll just change the
column to search and the string to look for...

Public Sub CopyAll()
Call CopyFromSheets("B", "this")
Call CopyFromSheets("B", "that")
Call CopyFromSheets("B", "the other")
End Sub

Private Sub CopyFromSheets(ByVal strCol As String, _
ByVal strWhat As String)
Dim wks As Worksheet
Dim rngFound As Range

For Each wks In Worksheets
On Error Resume Next
Set rngFound = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0
If Not rngFound Is Nothing Then
rngFound.Offset(0, 1).Copy _
Destination:=Sheets("Summary").Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
Set rngFound = Nothing
End If

Next wks
End Sub

Private Function FindStuff(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String

Set rngFound = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound Is Nothing Then
Set FindStuff = Nothing
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
Set FindStuff = rngFoundAll
End If
End Function

--
HTH...

Jim Thomlinson


"ryguy7272" wrote:

Thanks to everyone for all the help before. I have one more question. I
have a macro that creates several dozen worksheets (all with publicly traded
stock information). The worksheets dont exist until I query
finance.yahoo.com and import all information from this web site. When the
macro is executed, a spreadsheet is created for each stock, and the data is
imported to each relevant sheet. Now I get more data than I need, so I am
trying to figure out a way to reference each sheet (it has to be a loop) and
identify, or find, certain strings, such as "Forward P/E (1 yr):", "PEG Ratio
(5 yr expected):", "Annual EPS Est (Aug-07):" (the (Aug-07) part is certain
to create obvious problems unless I can set this up to search for "ESP"
within the string), etc. Then I have to find the value to the right of this
string (perhaps offset (0 ,1)).

Something like...search...ok "Forward P/E (1 yr):" is in column D and row 1
(it may not always be here, but it will be close; thats why I have to search
for it)...shift right one cell...copy/paste that value onto a sheet called
"Summary Sheet" in cell c3, then loop back and get the next "Forward P/E (1
yr):" in the next sheet. When this column is done, start looking for "PEG
Ratio (5 yr expected):", "Annual EPS Est (Aug-07):", the corresponding value,
etc.

Any ideas? Some help would be much appreciated. When I have a full working
model, I will post my code here for the benefit of others€¦

Regards,
RyGuy