On Mar 24, 4:10*pm, wrote:
On Mar 24, 7:57*am, joecrabtree wrote:



All,

I have a large number of worksheets. Each worksheet is named after a
date. For example 'DATE 02.05.09' What I would like to do is for all
the dates (Worksheets) in the workbook extract the relevant data from
the worksheet and place it into a summary sheet.

The specific data is defined by the summary sheet. For example if the
code EAS is entered, it would search for all the EAS's in the date
work sheets and return the individual values into the summary sheet.
As shown below:

The summary sheet would look like this.

DATE * * *CODE * VALUE
01.02.08 *EAS * * *44
02.02.08 *EAS * * *22
02.05.09 *LIN * * * *44

If anyone could give me some help it would be much appreciated.

Regards

Joseph Crabtree

Joseph,

I threw this code together quickly, so you'll need to test it to make
sure it is doing what you want. *I don't know how you plan on telling
the program what codes (i.e. "EAS", "LIN", etc.) to look for, so I
created a simple Array in the program. *The program assumes that the
value for each code is one column to the right of the code. *The
program also assumes you are searching within the UsedRange (i.e. all
cells that have been used at some point in time by the worksheet) to
find the codes. *Lastly, it assumes your summary data on the Summary
worksheet begins in A1.

I hope this gets you enough code to manipulate it to fit your needs.

Best,

Matt Herbert

Sub CustomFind()

Dim rngData As Range
Dim rngItem As Range
Dim rngFound As Range
Dim rngFirstFound As Range
Dim rngLastCell As Range
Dim rngListFound As Range
Dim wksSumm As Worksheet
Dim lngOutCnt As Long
Dim Wks As Worksheet
Dim strWksDate As String
Dim varMyArray As Variant
Dim lngJ As Long

'code to look for
varMyArray = Array("EAS", "LIN")

Set wksSumm = Worksheets("Summary")

'loop through each worksheet
For Each Wks In ActiveWorkbook.Worksheets
* * 'skip the worksheet if it is the Summary worksheet
* * If Wks.Name < wksSumm.Name Then
* * * * 'reset the Found ranges for each worksheet
* * * * Set rngFirstFound = Nothing
* * * * Set rngListFound = Nothing

* * * * 'get the date from the worksheet name
* * * * strWksDate = Right(Wks.Name, Len(Wks.Name) - _
* * * * * * * * * * InStr(1, Wks.Name, " ", vbTextCompare))

* * * * 'set the range to look in for each worksheet
* * * * Set rngData = Wks.UsedRange

* * * * 'get the last cell of the range
* * * * Set rngLastCell = rngData.Cells(rngData.Cells.Count)

* * * * 'loop through the codes to find all occurances
* * * * For lngJ = LBound(varMyArray) To UBound(varMyArray)

* * * * * * 'see "Remarks" in Find Method documentation
* * * * * * Set rngFound = rngData.Find(What:=varMyArray(lngJ), _
* * * * * * * * * * * * * * * * * * * * After:=rngLastCell, _
* * * * * * * * * * * * * * * * * * * * LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * * LookAt:=xlPart, _
* * * * * * * * * * * * * * * * * * * * SearchOrder:=xlByRows)

* * * * * * If Not rngFound Is Nothing Then

* * * * * * * * 'rngFirstFound acts as a "marker" to identify when
* * * * * * * * ' we have looped through all possible finds, i.e.
* * * * * * * * ' we are back at the beginning again
* * * * * * * * Set rngFirstFound = rngFound

* * * * * * * * 'if there is only one item that is found then the
* * * * * * * * ' one item is the result of the find
* * * * * * * * Set rngListFound = rngFound

* * * * * * * * 'get the next find; this may or may not exist
* * * * * * * * Set rngFound = rngData.FindNext(After:=rngFound)

* * * * * * * * 'loop for all possible finds
* * * * * * * * Do
* * * * * * * * * * 'this is to catch if there is one item found as
* * * * * * * * * * ' well as to determine if we are at the beginning
* * * * * * * * * * ' "marker" of our find list
* * * * * * * * * * If rngFound.Address = rngFirstFound.Address Then
* * * * * * * * * * * * Exit Do
* * * * * * * * * * End If

* * * * * * * * * * 'this is to add the multiple found ranges into
* * * * * * * * * * ' the rngListFound; union appends the new found
* * * * * * * * * * ' item range to the existing found item range
* * * * * * * * * * Set rngListFound = Application.Union(rngListFound,
rngFound)

* * * * * * * * * * 'since we are in a loop, we need to set the
* * * * * * * * * * ' rngFound to the next find; this may or may
* * * * * * * * * * ' not exist
* * * * * * * * * * Set rngFound = rngData.FindNext(After:=rngFound)
* * * * * * * * Loop

* * * * * * * * 'output results to the Summary worksheet
* * * * * * * * For Each rngItem In rngListFound
* * * * * * * * * * With wksSumm
* * * * * * * * * * * * lngOutCnt = .Range
("a1").CurrentRegion.Rows.Count
* * * * * * * * * * * * .Cells(lngOutCnt + 1, "A").Value = varMyArray
(lngJ)
* * * * * * * * * * * * .Cells(lngOutCnt + 1, "B").Value = strWksDate
* * * * * * * * * * * * .Cells(lngOutCnt + 1, "C").Value =
rngItem.Offset(0, 1).Value
* * * * * * * * * * End With
* * * * * * * * Next
* * * * * * End If
* * * * Next
* * End If
Next

End Sub

Thanks for all your help on this. This works great.

Joe