Looping: Search Range in Multiple Selected Worksheets, Copy/Paste

[ryguy7272]

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 don’t 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; that’s 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

 

[Bernie Deitrick]

RyGuy,

The macro below will look for a set of values in all the sheets of the currently active workbook,
and create a table on Sheet1 of the workbook where the code resides: change the array myVals to
include all the strings (or unique substrings) that you are looking for.

Sub TryNow()
Dim mySht As Worksheet
Dim myCells As Variant
Dim myVals As Variant
Dim i As Integer
Dim j As Integer

myVals = Array("Forward P/E (1 yr):", "PEG Ratio (5 yr expected)", "Annual EPS Est")

For i = LBound(myVals) To UBound(myVals)
ThisWorkbook.Worksheets("Sheet1").Cells(i + 2, 1).Value = myVals(i)
Next i

j = 2
For Each mySht In ActiveWorkbook.Worksheets
For i = LBound(myVals) To UBound(myVals)
ThisWorkbook.Worksheets("Sheet1").Cells(1, j).Value = _
mySht.Name
ThisWorkbook.Worksheets("Sheet1").Cells(i + 2, j).Value = _
mySht.Cells.Find(myVals(i), , xlValues, xlPart).Offset(0, 1).Value
Next i
j = j + 1

Next mySht

End Sub

 

[Jim Thomlinson]

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

 

[ryguy7272]

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 can’t 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 doesn’t 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 doesn’t 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---
(e-mail address removed)

 

[Jim Thomlinson]

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]

BRILLIANT!!!
---
RyGuy

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]

My intention is not to duplicate work, or confuse people in any way, so
rather than post the entire solution here, I’ll just post the link to the
solution (I had a few different threads going in the past few weeks):

http://www.microsoft.com/office/com...5298&catlist=&dglist=&ptlist=&exp=&sloc=en-us

Look for title “Import from finance.yahoo.comâ€
Look in the top most post.

Merjet and Jim Thomlinson offered a tremendous amount of help (I couldn’t
have done it without them). Hopefully the final solution helps others too!!!