ExcelBanter - macro with drop doown box to to find name in 40 work books

I assume the drop down box was a validation list on Sheet1 (change sheet if
necessary). The macro creates a new sheet called summary. The names of the
list are put in column A on the new sheet. Column B is the workbook name and
Column C is the worksheet.

The macro opens each workbook(*.xlsb) and finds the name in cell E14 on each
sheet. Then looks at the summary list for the name and does one of 3 things

1) If the name is found then put the workbook and sheet name in columns B & C
2) If name is not found the Display message indicating Name not found
3) If Workbook name is already filled in the Display message indicating Name
already Exists.

Sub GetNames()

Folder = "C:\Users\TQLS JIM\Desktop\DPBP AIR PROGRAM\CUSTOMERS\"

'Create Newsheet with names for summary
With ThisWorkbook
Set SumSheet = .Sheets.Add(after:=.Sheets.Count)
End With

With ThisWorkbook.Sheets("Sheet1")
ValidationFormula = .Range("AB55").Validation.Formula1
'remove equal sign
ValidationFormula = Mid(ValidationFormula, 2)
Set ValRange = .Range(ValidationFormula)
ValRange.Copy destination:=SumSheet.Range("A2")
End With

With SumSheet
.Range("A1") = "Name"
.Range("B1") = "Workbook"
.Range("C1") = "Worksheet"
FName = Dir(Folder & "*.xlsb")
Do While FName < ""
Set bk = Workbooks.Open(Filename:=Folder & FName)
For Each sht In bk.Sheets
Person = sht.Range("E14")
Set c = .Columns("A").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Name : " & Person & " - Not in List")
Else
If c.Offset(0, 1).Value = "" Then
c.Offset(0, 1).Value = FName
c.Offset(0, 2).Value = sht.Name
Else
MsgBox ("Name : " & Person & _
" - Is in more than one Workbook/WorkSheet")
End If
End If
Next sht
bk.Close savechanges:=False
FName = Dir()
Loop
End With
End Sub

"Donald E" wrote:

I have a work book name menu with a drop down box in cell ( AB55 ) with names
in it.
need a macro to find names, in work books on desk top I have 40 work books
to serch in. Each Work Book Has 50 Sheets , Name Sheet1 Thu Sheet50 The names
are in cell ( E14 ) If any one can help me I surley Thank You.

Don
PS This is the Path.

Workbooks.Open(Filename:= _
"C:\Users\TQLS JIM\Desktop\DPBP AIR
PROGRAM\CUSTOMERS\Customer-1.xlsb", _
UpdateLinks:=0).RunAutoMacros Which:=xlAutoOpen