Could someone help me to modify the appended code from Ron de Bruins web
site, please? The values I really want to obtain are shown in the code
(namely in D1,O20,O38) but rather than hard coding D1,O20,O38 I would like to
use €œfind€� and then €œoffset€� to obtain them and use the code of €œfind€� and
€œoffset€� to replace: €œSet Rng = Range("D1,O20,O38")€�. To restate this:
I would like to €œfind€� the text: €œLot*€� (located in B1) then offset 2
columns to the right to arrive at D1
I would like to €œfind€� the text: €œGrand*€� (located in N20) then offset 1
column to the right to arrive at O20
I would like to €œfind€� the text: €œGrand*€� (located in N38) then offset 1
column to the right to arrive at O38
This would allow for someone typing one of the key words of €œLot€� or €œGrand€�
in a different cell but still return the value that is referenced by these
labels. Or if there is a better way than using €œfind€� and €œoffset€� then that
would be good too. The texts are actually: €œLot # :€� and €œGrand Average:€� but
I was thinking to search with a wild card, * as sometimes the text is typed
slightly different, eg: Avg instead of Average. I am using Excel 2007 with
Vista. This is my first newsgroup post. Thanks, John Yab.

Sub TagTeam_QA()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String

ShName = "QA" '<---- matches the name of the sheet to be searched
Set Rng = Range("D1,O20,O38") '<---- matches the specific cells to
collect

'Select the files with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files,
*.xl*", MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing

'Change ScreenUpdating and calculation to increase speed of macro
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 3
RwNum = 2

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1
FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'",
"''")
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName
& "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(,
, xlR1C1))
If Err.Number < 0 Then
'If the sheet named per first comment(QA)does not exist in
the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count +
1).Interior.Color = vbYellow

Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

'Add titles to columns and format to center some titles
Range("A1").FormulaR1C1 = "Workbook Name"
Range("B1").FormulaR1C1 = "Lot #"
Range("A1").Select

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Workbook Name"
Range("A1").Select


With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If

--
John Yab