I have about 148 files in an Excel directory. Is there an easy way to search
the first four rows of all these files and find the word 'title'. If that
word exists, I would then like to copy the word that is next (the cell to the
right) to that word and paste it in a new file. If the word 'title' is in
cell K4, the actual title will be in L4.

I would then like to copy the contents of the title and the name of the file
(or its path) to a new file called, say, Lists.xls.

Not all files in the directory will contain the word title. All the files
currently reside in C:\UFBooks

If this can be done it would be a huge time saver. Thanks for you help.

Elaine,

Try the macro below. Let me know if it works out OK.

This assumes that "Title" is only found once in the top four rows....

HTH,
Bernie
MS Excel MVP

Option Explicit
Sub FindTitles()
Dim mySht As Worksheet
Dim WorkFile As String
Dim myPath As String
Dim myFind As Range

Set mySht = ActiveSheet
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

myPath = "C:\UFBooks\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile < ""
Workbooks.Open Filename:=myPath & WorkFile
Set myFind = Range("1:4").Find("Title")
If myFind Is Nothing Then GoTo NotFound
mySht.Cells(Rows.Count, 1).End(xlUp)(2).Value = _
WorkFile
mySht.Cells(Rows.Count, 2).End(xlUp)(2).Value = _
myFind(1, 2).Value
NotFound:
ActiveWorkbook.Close False
WorkFile = Dir()
Loop

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub


"Elaine" wrote in message
...
I have about 148 files in an Excel directory. Is there an easy way to search
the first four rows of all these files and find the word 'title'. If that
word exists, I would then like to copy the word that is next (the cell to the
right) to that word and paste it in a new file. If the word 'title' is in
cell K4, the actual title will be in L4.

I would then like to copy the contents of the title and the name of the file
(or its path) to a new file called, say, Lists.xls.

Not all files in the directory will contain the word title. All the files
currently reside in C:\UFBooks

If this can be done it would be a huge time saver. Thanks for you help.

Thank you very much for your help, Bernie.

I ran the macro but nothing seemed to happen!

I opened a blank workbook with sheet1 and ran the macro and nothing happened.
I also opened a file called list.xls and ran the file and nothing happened.
I also ran Debug | Compile Project and found no errors. (The only changes
that I made were to remove the underscores after the "=" signs.

I double checked and found that there were several files with the word title
and a title next to it.

Is there any other thing that you can suggest. I am sure that I have made
some mistake but I don't know what it is.

--Elaine

"Bernie Deitrick" wrote:

Elaine,

Try the macro below. Let me know if it works out OK.

This assumes that "Title" is only found once in the top four rows....

HTH,
Bernie
MS Excel MVP

Option Explicit
Sub FindTitles()
Dim mySht As Worksheet
Dim WorkFile As String
Dim myPath As String
Dim myFind As Range

Set mySht = ActiveSheet
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

myPath = "C:\UFBooks\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile < ""
Workbooks.Open Filename:=myPath & WorkFile
Set myFind = Range("1:4").Find("Title")
If myFind Is Nothing Then GoTo NotFound
mySht.Cells(Rows.Count, 1).End(xlUp)(2).Value = _
WorkFile
mySht.Cells(Rows.Count, 2).End(xlUp)(2).Value = _
myFind(1, 2).Value
NotFound:
ActiveWorkbook.Close False
WorkFile = Dir()
Loop

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub


"Elaine" wrote in message
...
I have about 148 files in an Excel directory. Is there an easy way to search
the first four rows of all these files and find the word 'title'. If that
word exists, I would then like to copy the word that is next (the cell to the
right) to that word and paste it in a new file. If the word 'title' is in
cell K4, the actual title will be in L4.

I would then like to copy the contents of the title and the name of the file
(or its path) to a new file called, say, Lists.xls.

Not all files in the directory will contain the word title. All the files
currently reside in C:\UFBooks

If this can be done it would be a huge time saver. Thanks for you help.