Hi,

I'm trying to get all the email addresses from a worksheet called
"Admin" across to a separate workbook.

I am able to copy and paste from a specific cell but certain workbooks
have the email address in different cells so I need something that
gets all the email addresses in a particular sheet and spits it out to
the new workbook.

I keep getting no addresses at all while attempting to do this
currently.

Thanks,
Mark.

Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?


Rick Rothstein (MVP - Excel)

On Mon, 21 Nov 2011 23:13:56 -0800 (PST), Mark wrote:

Hi,

I'm trying to get all the email addresses from a worksheet called
"Admin" across to a separate workbook.

I am able to copy and paste from a specific cell but certain workbooks
have the email address in different cells so I need something that
gets all the email addresses in a particular sheet and spits it out to
the new workbook.

I keep getting no addresses at all while attempting to do this
currently.

Thanks,
Mark.

You don't give a lot of information about your setup, with which the following might be able to be simplified.

The macro below will iterate through all open workbooks that have a worksheet named Admin, omitting the workbook where you want to put the results (Book3 in this version, but you can change it). It will look through the entire worksheet for anything that looks like an email address (excluding email addresses that are designated by an IP address) and place them into an array). The email addresses can be alone in a cell; embedded within text; and there can be more than one email address in a cell.

It will then output those email addresses into column A on Sheet1 of Book3 (or whatever you designate).

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

The macro can be in any workbook, but it would be best to place it in the workbook that stores your email addresses.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN.

========================================
Option Explicit
Sub ExtrEmails()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim wb As Workbook
Dim vRes() As Variant
Dim i As Long
Dim re As Object, mc As Object
Dim bFirstRun As Boolean
Const sPatEmail As String = "\b[A-Z0-9._%+-]+@(?:[A-Z0-9-]+\.)+[A-Z]{2,6}\b"

'Set up location where you want results to go
Set rDest = Workbooks("Book3").Worksheets("Sheet1").Range("A1" )
rDest.Worksheet.Cells.ClearContents

Set re = CreateObject("vbscript.regexp")
With re
.Pattern = sPatEmail
.Global = True
.ignorecase = True
End With

bFirstRun = True
For Each wb In Workbooks
If Not wb.Name = "Book3" Then 'or whatever book holds the results
Set rSrc = wb.Worksheets("Admin").UsedRange

For Each c In rSrc
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
If bFirstRun = False Then
ReDim Preserve vRes(0 To UBound(vRes) + mc.Count)
Else
ReDim vRes(0 To mc.Count - 1)
bFirstRun = False
End If
For i = 1 To mc.Count
vRes(UBound(vRes) - mc.Count + i) = mc(i - 1)
Next i
End If
Next c

End If
Next wb

Set rDest = rDest.Resize(rowsize:=UBound(vRes) + 1)
rDest = WorksheetFunction.Transpose(vRes)

End Sub
================================

On Nov 22, 3:00*am, "Rick Rothstein"
wrote:
Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?

Rick Rothstein (MVP - Excel)

As Rick says, details, but you may eventually use a macro using
FINDNEXT to look for partial hits on "@" and moving that cell or row
or? from _____ to where_____________

On Tue, 22 Nov 2011 08:16:51 -0500, Ron Rosenfeld wrote:

Cleaned up a bit with some error checking:

=============================
Option Explicit
Sub ExtrEmails()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim wb As Workbook, ws As Worksheet
Dim vRes() As Variant
Dim i As Long
Dim re As Object, mc As Object
Dim bFirstRun As Boolean
Const sPatEmail As String = "\b[A-Z0-9._%+-]+@(?:[A-Z0-9-]+\.)+[A-Z]{2,6}\b"

'Set up location where you want results to go
Set rDest = ThisWorkbook.Worksheets("Sheet1").Range("A1")
rDest.Worksheet.Cells.ClearContents

Set re = CreateObject("vbscript.regexp")
With re
.Pattern = sPatEmail
.Global = True
.ignorecase = True
End With

bFirstRun = True
For Each wb In Workbooks
If Not wb.Name = "Book3" Then 'or whatever book holds the results
On Error Resume Next
Set ws = wb.Worksheets("Admin")
On Error GoTo 0
If Not ws Is Nothing Then
Set rSrc = wb.Worksheets("Admin").UsedRange

For Each c In rSrc
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
If bFirstRun = False Then
ReDim Preserve vRes(0 To UBound(vRes) + mc.Count)
Else
ReDim vRes(0 To mc.Count - 1)
bFirstRun = False
End If
For i = 1 To mc.Count
vRes(UBound(vRes) - mc.Count + i) = mc(i - 1)
Next i
End If
Next c

End If
End If
Next wb

If bFirstRun = False Then
Set rDest = rDest.Resize(rowsize:=UBound(vRes) + 1)
rDest = WorksheetFunction.Transpose(vRes)
End If

End Sub
============================

On Nov 22, 8:00*pm, "Rick Rothstein"
wrote:
Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?

Rick Rothstein (MVP - Excel)

Yeah sorry guys found it hard to be specific without including loads
of useless rubbish too :)

But to answer questions.

Sometimes the Admin sheet will have 1 email address but other times it
will have many.
These will generally be in columns D-F (unfortunately i don't have
control of those sheets otherwise they'd all be in the exact same
cell)

Will try out Ron's script and let you guys know how i go.

Thanks for the advice.

Oh 1 more thing I forgot is that it will be opening multiple workbooks
in a specific folder e.g ("mark\documents\data")

On Tue, 22 Nov 2011 16:17:48 -0800 (PST), Mark wrote:

Oh 1 more thing I forgot is that it will be opening multiple workbooks
in a specific folder e.g ("mark\documents\data")

If you try my script, try it first after you manually open all of the documents -- we can include that once we get the basics ironed out.

Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.

Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
FNum As Long


MyPath = "\\NBN2k8003\Data\NSOC - Docklands\Access Seekers\Access
Seeker Contact Matrices.Fibre"

Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.


Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim FNum As Long

MyPath = "\\mypath"

FNum = 0
Do While FilesInPath < ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


If FNum 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0


However no workbooks try to open.

This is a work project btw and I'll be off from now for the next 48
hours so most likely wont look here again until then.

Thanks again for the help.

On Nov 23, 12:10*pm, Ron Rosenfeld wrote:
On Tue, 22 Nov 2011 16:17:48 -0800 (PST), Mark wrote:
Oh 1 more thing I forgot is that it will be opening multiple workbooks
in a specific folder e.g ("mark\documents\data")

If you try my script, try it first after you manually open all of the documents -- we can include that once we get the basics ironed out.


OK that worked perfectly with it open (I wrote this earlier but it
hasn't appeared so sorry if this doubles up later)

In addition to your code I have

Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim FNum as Long

MyPath = "mypath"

FNum = 0
Do While FilesInPath < ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop

If FNum 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0
=====================================

however it is not opening any books.

Thanks again for all your help with this.

Ps. this is a work project and I won't be back here for another 48
hours so there may be a delay in my next response.
'

On Tue, 22 Nov 2011 17:19:25 -0800 (PST), Mark wrote:

Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.

Mark,

Here is some code that I use when I need to open a bunch of workbooks. I have modified it a bit for you and also made some comments.
For reasons not related to this project, most of the variables are declared as Public variables. What that means, if you choose to use it, is that you may need to avoid duplicate declarations in other code.

Note that the Pathname (string) must end with the "\"

Also note the spot where you can test the filename before opening the workbook, if that may be of any benefit.

Finally, you must set a reference to Microsoft Scripting Runtime. On the main menu of the VBE, select References and then look for Microsoft Scripting Runtime in the pull down.

====================================
'requires reference to Microsoft Scripting Runtime
Public wbk As Workbook
Public Path As String
Public wbPrefix As String
Public wbName As String
Public oFS As FileSystemObject, Fo As Folder, F As File
Option Explicit
Option Private Module
Public Sub OpenEmailSourceFiles()
'note the terminal "\" in Path definition
Path = "Your_Path" & "\"
Set oFS = New FileSystemObject

Set Fo = oFS.GetFolder(Path)
For Each F In Fo.Files
Debug.Print F.Name 'This line just for debugging

'If it returns the correct filenames, uncomment the
'next line, and delete the debug.print line
'you could also include some testing for file names if you
'don't need to open all the files in the folder

'Workbooks.Open (Path & F.Name)
Next F
Set oFS = Nothing
End Sub
'-------------------------------------------------------
Public Sub CloseEmailSourceFiles()
'clean up the mess by closing all those files
For Each wbk In Workbooks
If wb.Name < "The Name Of Your Results File" Then
wb.Close savechanges:=False
End If
Next wb
End Sub

On Tue, 22 Nov 2011 21:55:45 -0500, Ron Rosenfeld wrote:

On Tue, 22 Nov 2011 17:19:25 -0800 (PST), Mark wrote:

Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.

Mark,

Here is some code that I use when I need to open a bunch of workbooks. I have modified it a bit for you and also made some comments.
For reasons not related to this project, most of the variables are declared as Public variables. What that means, if you choose to use it, is that you may need to avoid duplicate declarations in other code.

Note that the Pathname (string) must end with the "\"

Also note the spot where you can test the filename before opening the workbook, if that may be of any benefit.

Finally, you must set a reference to Microsoft Scripting Runtime. On the main menu of the VBE, select References and then look for Microsoft Scripting Runtime in the pull down.

====================================
'requires reference to Microsoft Scripting Runtime
Public wbk As Workbook
Public Path As String
Public wbPrefix As String
Public wbName As String
Public oFS As FileSystemObject, Fo As Folder, F As File
Option Explicit
Option Private Module
Public Sub OpenEmailSourceFiles()
'note the terminal "\" in Path definition
Path = "Your_Path" & "\"
Set oFS = New FileSystemObject

Set Fo = oFS.GetFolder(Path)
For Each F In Fo.Files
Debug.Print F.Name 'This line just for debugging

'If it returns the correct filenames, uncomment the
'next line, and delete the debug.print line
'you could also include some testing for file names if you
'don't need to open all the files in the folder

'Workbooks.Open (Path & F.Name)
Next F
Set oFS = Nothing
End Sub
'-------------------------------------------------------
Public Sub CloseEmailSourceFiles()
'clean up the mess by closing all those files
For Each wbk In Workbooks
If wb.Name < "The Name Of Your Results File" Then
wb.Close savechanges:=False
End If
Next wb
End Sub

I forgot to write that, after you get this working, you would use this code by inserting calls to these macros within the basic routine.

You could put a line:

OpenEmailSourceFiles just after the initial declarations in the Extract email macro

and put:

CloseEmailSourceFiles

just before the Exit Sub in that macro.

On Nov 23, 2:00*pm, Ron Rosenfeld wrote:
On Tue, 22 Nov 2011 21:55:45 -0500, Ron Rosenfeld wrote:
On Tue, 22 Nov 2011 17:19:25 -0800 (PST), Mark wrote:

Tried Ron's and it works to a degree. *If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. *I currently have the following extra code in addition
to Rons but it is not opening any workbooks.

Mark,

Here is some code that I use when I need to open a bunch of workbooks. *I have modified it a bit for you and also made some comments.
For reasons not related to this project, most of the variables are declared as Public variables. *What that means, if you choose to use it, is that you may need to avoid duplicate declarations in other code.

Note that the Pathname (string) must end with the "\"

Also note the spot where you can test the filename before opening the workbook, if that may be of any benefit.

Finally, you must set a reference to Microsoft Scripting Runtime. *On the main menu of the VBE, select References and then look for Microsoft Scripting Runtime in the pull down.

====================================
'requires reference to Microsoft Scripting Runtime
Public wbk As Workbook
Public Path As String
Public wbPrefix As String
Public wbName As String
Public oFS As FileSystemObject, Fo As Folder, F As File
Option Explicit
Option Private Module
Public Sub OpenEmailSourceFiles()
'note the terminal "\" in Path definition
Path = "Your_Path" & "\"
Set oFS = New FileSystemObject

Set Fo = oFS.GetFolder(Path)
* *For Each F In Fo.Files
* * * *Debug.Print F.Name 'This line just for debugging

* * * *'If it returns the correct filenames, uncomment the
* * * *'next line, and delete the debug.print line
* * * *'you could also include some testing for file names if you
* * * *'don't need to open all the files in the folder

* * * *'Workbooks.Open (Path & F.Name)
* *Next F
Set oFS = Nothing
End Sub
'-------------------------------------------------------
Public Sub CloseEmailSourceFiles()
'clean up the mess by closing all those files
For Each wbk In Workbooks
* *If wb.Name < "The Name Of Your Results File" Then
* * * *wb.Close savechanges:=False
* *End If
Next wb
End Sub

I forgot to write that, after you get this working, you would use this code by inserting calls to these macros within the basic routine.

You could put a line:

OpenEmailSourceFiles * just after the initial declarations in the Extract email macro

and put:

CloseEmailSourceFiles

just before the Exit Sub in that macro.

OK thanks for that Ron, it looks like it will work properly but I have
2 small problems still.

1) Unfortunately the folder I am scraping from is not mine so it has
the occassional rubbish leftover file that starts with ~$ that office
leaves behind. The macro errors when trying to open that. This is
minor and I can get around it by copying and pasting to another
folder.

2) I am getting a subscript out of range error (run time error 9) with
the following line highlighted

Set rSrc = wb.Worksheets("Admin").UsedRange

I believe it might be because the the code says

For Each wb In Workbooks

yet wb is not defined anywhere. Would that be correct? I've tried a
few different things but they all fail and bring up a new error :)

Thanks.

On Thu, 24 Nov 2011 20:40:43 -0800 (PST), Mark wrote:

OK thanks for that Ron, it looks like it will work properly but I have
2 small problems still.

1) Unfortunately the folder I am scraping from is not mine so it has
the occassional rubbish leftover file that starts with ~$ that office
leaves behind. The macro errors when trying to open that. This is
minor and I can get around it by copying and pasting to another
folder.

Why not just test the filenames as I indicated you could in the file open routine?

This part he

========================
Set Fo = oFS.GetFolder(Path)
For Each F In Fo.Files
Debug.Print F.Name 'This line just for debugging

'If it returns the correct filenames, uncomment the
'next line, and delete the debug.print line
'you could also include some testing for file names if you
'don't need to open all the files in the folder

'Workbooks.Open (Path & F.Name)
Next F
===============================

Change the area between

For Each F and Next F to:

If Not F.Name Like "~$*" then
Workbooks.Open(Path & F.Name)
end if







2) I am getting a subscript out of range error (run time error 9) with
the following line highlighted

Set rSrc = wb.Worksheets("Admin").UsedRange

I believe it might be because the the code says

For Each wb In Workbooks

yet wb is not defined anywhere. Would that be correct? I've tried a
few different things but they all fail and bring up a new error :)


You are probably using the first version of the ExtrEmails macro where I did not check to be sure an Admin worksheet was present, because that would give that error. But wb was declared in the declarations area on both versions, so I don't know why you don't have that line there.

Here is that second version again:

=============================
Option Explicit
Sub ExtrEmails()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim wb As Workbook, ws As Worksheet
Dim vRes() As Variant
Dim i As Long
Dim re As Object, mc As Object
Dim bFirstRun As Boolean
Const sPatEmail As String = "\b[A-Z0-9._%+-]+@(?:[A-Z0-9-]+\.)+[A-Z]{2,6}\b"

'Set up location where you want results to go
Set rDest = ThisWorkbook.Worksheets("Sheet1").Range("A1")
rDest.Worksheet.Cells.ClearContents

Set re = CreateObject("vbscript.regexp")
With re
.Pattern = sPatEmail
.Global = True
.ignorecase = True
End With

bFirstRun = True
For Each wb In Workbooks
If Not wb.Name = "Book3" Then 'or whatever book holds the results
On Error Resume Next
Set ws = wb.Worksheets("Admin")
On Error GoTo 0
If Not ws Is Nothing Then
Set rSrc = wb.Worksheets("Admin").UsedRange

For Each c In rSrc
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
If bFirstRun = False Then
ReDim Preserve vRes(0 To UBound(vRes) + mc.Count)
Else
ReDim vRes(0 To mc.Count - 1)
bFirstRun = False
End If
For i = 1 To mc.Count
vRes(UBound(vRes) - mc.Count + i) = mc(i - 1)
Next i
End If
Next c

End If
End If
Next wb

If bFirstRun = False Then
Set rDest = rDest.Resize(rowsize:=UBound(vRes) + 1)
rDest = WorksheetFunction.Transpose(vRes)
End If

End Sub
============================

And I have also noted a problem with the File Handling routines that I will correct here; it has to do with the File Close routine:

====================================
'requires reference to Microsoft Scripting Runtime
Public wbk As Workbook
Public Path As String
Public wbPrefix As String
Public wbName As String
Public oFS As FileSystemObject, Fo As Folder, F As File
Option Explicit
Option Private Module
Public Sub OpenEmailSourceFiles()
'note the terminal "\" in Path definition
Path = "Your_Path" & "\"
Set oFS = New FileSystemObject

Set Fo = oFS.GetFolder(Path)
For Each F In Fo.Files
Debug.Print F.Name 'This line just for debugging

'If it returns the correct filenames, uncomment the
'next line, and delete the debug.print line
'you could also include some testing for file names if you
'don't need to open all the files in the folder

'Workbooks.Open (Path & F.Name)
Next F
Set oFS = Nothing
End Sub
'-------------------------------------------------------
Public Sub CloseEmailSourceFiles()
'clean up the mess by closing all those files
For Each wbk In Workbooks
If wbk.Name < "The Name Of Your Results File" Then
wbk.Close savechanges:=False
End If
Next wbk
End Sub
========================

Change the area between

For Each F * * *and * * Next F * * to:

If *Not F.Name *Like "~$*" then
* *Workbooks.Open(Path & F.Name)
end if


That worked perfectly. Cheers


You are probably using the first version of the ExtrEmails macro where I did not check to be sure an Admin worksheet was present, because that would give that error. *But wb was declared in the declarations area on both versions, so I don't know why you don't have that line there.

No I was using the 2nd version already. Poor wordchoice on my part
before. By declare I meant specify what exactly wb is. So we have
declared that wb is a Workbook but we haven't defined which workbooks
it should be searching to get the information.

So here is the exact code I have at the moment up until the error part
that gives subscript out of range.



Sub Admin()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim wb As Workbook, ws As Worksheet
Dim vRes() As Variant
Dim i As Long
Dim re As Object, mc As Object
Dim bFirstRun As Boolean
Const sPatEmail As String = "\b[A-Z0-9._%+-]+@(?:[A-Z0-9-]+\.)+[A-
Z]{2,6}\b"

OpenEmailSourceFiles

Set rDest = ThisWorkbook.Worksheets("Sheet2").Range("A1")
rDest.Worksheet.Cells.ClearContents

Set re = CreateObject("vbscript.regexp")
With re
.Pattern = sPatEmail
.Global = True
.ignorecase = True
End With

bFirstRun = True
For Each wb In Workbooks
If Not wb.Name = "C:\Users\xxxxx\admin details.xlsm" Then 'this is the
book that i want the email addresses pasted into
On Error Resume Next
Set ws = wb.Worksheets("Admin")
On Error GoTo 0
If Not ws Is Nothing Then
Set rSrc = wb.Worksheets("Admin").Range("A1:Z99")
================================================== ==================

I get the same error when I I have any range defined and also when I
use the simple .UsedRange

Oh for crying out loud!!!!! I worked it out. I opened all 32
spreadsheets and found 1 of them had a sheet named "Administration"
instead of "Admin"

Tested again and code worked flawlessly!

Thankyou so much for your time and patience Ron!!!!

On Sun, 27 Nov 2011 22:22:49 -0800 (PST), Mark wrote:

Oh for crying out loud!!!!! I worked it out. I opened all 32
spreadsheets and found 1 of them had a sheet named "Administration"
instead of "Admin"

Tested again and code worked flawlessly!

Thankyou so much for your time and patience Ron!!!!

I'm glad you found and corrected the problem. Except I would have expected the code to skip over the wb that did not have an "Admin" worksheet. There must be something else going on, but if what you have is working, no need to pursue it except out of curiousity.

Thanks for the feedback.

On Sun, 27 Nov 2011 22:20:11 -0800 (PST), Mark wrote:

So we have
declared that wb is a Workbook but we haven't defined which workbooks
it should be searching to get the information.

The workbook that wb gets assigned to is via the :

For Each wb In Workbooks

statement.

Then we except the wb that you have the results going into, and we should also be skipping any wb's that don't have an "Admin" worksheet. So I don't understand your error you mentioned in your next post, unless possibly that workbook had an Admin worksheet, but had its data on the Administration worksheet.

On Nov 28, 4:14*pm, Ron Rosenfeld wrote:
On Sun, 27 Nov 2011 22:20:11 -0800 (PST), Mark wrote:
So we have
declared that wb is a Workbook but we haven't defined which workbooks
it should be searching to get the information.

The workbook that wb gets assigned to is via the :

For Each wb In Workbooks

statement.

Then we except the wb that you have the results going into, and we should also be skipping any wb's that don't have an "Admin" worksheet. *So I don't understand your error you mentioned in your next post, unless possibly that workbook had an Admin worksheet, but had its data on the Administration worksheet.

Thanks for that explanation, makes sense now.

I can see the code there that should be skipping over wb's without an
"Admin" sheet but it definitely errors when it has a different name
(also no "Admin" sheet on the one with the incorrect name).

In a perfect World I'd have the code skipping over those books but I'm
ok to do the better housekeeping to keep all wb's consistent.

Thanks Again

On Thu, 1 Dec 2011 18:34:40 -0800 (PST), Mark wrote:

On Nov 28, 4:14*pm, Ron Rosenfeld wrote:
On Sun, 27 Nov 2011 22:20:11 -0800 (PST), Mark wrote:
So we have
declared that wb is a Workbook but we haven't defined which workbooks
it should be searching to get the information.

The workbook that wb gets assigned to is via the :

For Each wb In Workbooks

statement.

Then we except the wb that you have the results going into, and we should also be skipping any wb's that don't have an "Admin" worksheet. *So I don't understand your error you mentioned in your next post, unless possibly that workbook had an Admin worksheet, but had its data on the Administration worksheet.

Thanks for that explanation, makes sense now.

I can see the code there that should be skipping over wb's without an
"Admin" sheet but it definitely errors when it has a different name
(also no "Admin" sheet on the one with the incorrect name).

In a perfect World I'd have the code skipping over those books but I'm
ok to do the better housekeeping to keep all wb's consistent.

Thanks Again

Puzzling over the code, I think I have found the problem. Once ws gets set to an admin worksheet, it remains set there, and doesn't go back to "nothing" when we check the next wb. Hence the error.

Try adding

Set ws = Nothing

in that section as shown below, and that should take care of the error.

--------------------------

For Each wb In Workbooks
If Not wb.Name = "Book2" Then 'or whatever book holds the results
Set ws = Nothing
On Error Resume Next
Set ws = wb.Worksheets("Admin")
On Error GoTo 0
If Not ws Is Nothing Then
Set rSrc = wb.Worksheets("Admin").UsedRange

-------------------------------------------------