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
