Hi All

I'm trying to adjust the following code which some amazing experts from this
discussion group have written for me - but (being a novice) I obviously
haven't done it properly...
Your help would be appreciated:

The macro searches all workbooks except "Overview Template", GRP Wkly
Collection, the destination worksheet & hidden worksheets.

It needs to finds all worksheets where the defined range named:
"GRPResults", exists.
For all those worksheets, it copies the GRPResults range, and pastes
values/formats into the destination worksheet - creating a list of data from
all worksheets.

If it finds a worksheet that doesn't have the defined range "GRPResults" it
gives the user a message to say that this worksheet will be excluded and then
does just that.

At the moment the macro seems to stop running (with no error msg) when it
finds a worksheet that doesn't have the defined range named "GRPResults" and
does nothing??? What am I doing wrong??

Sub CopyGRPSections()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastRowDest As Long
Dim NewRowDest As Long
Dim LastRowSource As Long
Dim DestLoc As Range
Dim TestRng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("GRP Qtrly Collection").Range("A40:BJ3000").Cells.Clear

Set DestSh = ActiveWorkbook.Worksheets("GRP Qtrly Collection")

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Overview Template" And sh.Name < "GRP Wkly Collection" And
sh.Name < DestSh.Name And sh.Visible = True Then


'''''''''''Where it doesn't find the defined range named "GRPresults" on the
worksheet it needs to exclude that worksheet and continued through the others
& complete the code tasks on worksheets it did find


On Error Resume Next
Set TestRng = sh.Range("GRPResults") '''''' Should a defined range name
have "speech marks"?"
On Error GoTo 0

If TestRng Is Nothing Then
MsgBox sh.Name & " worksheet will be excluded"
Else

If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
LastRowDest = 40
Set DestLoc = DestSh.Range("A40")
Else
LastRowDest = DestSh.Range("A" & Rows.Count).End(xlUp).Row
NewRowDest = LastRowDest + 1
Set DestLoc = DestSh.Range("A" & NewRowDest)
End If

LastRowSource = sh.Range("A" & Rows.Count).End(xlUp).Row

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

End If
Exit For

TestRng.Copy
With DestLoc
..PasteSpecial xlPasteValues
..PasteSpecial xlPasteFormats
End With

End If
End If
Next

Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Thank for your help
BeSmart

Hi BeSmart

You code seems to be fine. Try this:

Goto Tools Options Genral tab Verify that 'Break on Unhandled Errors'
is selected in 'Error Trapping' section.

Hopes this helps.
....
Per

"BeSmart" skrev i meddelelsen
...
Hi All

I'm trying to adjust the following code which some amazing experts from
this
discussion group have written for me - but (being a novice) I obviously
haven't done it properly...
Your help would be appreciated:

The macro searches all workbooks except "Overview Template", GRP Wkly
Collection, the destination worksheet & hidden worksheets.

It needs to finds all worksheets where the defined range named:
"GRPResults", exists.
For all those worksheets, it copies the GRPResults range, and pastes
values/formats into the destination worksheet - creating a list of data
from
all worksheets.

If it finds a worksheet that doesn't have the defined range "GRPResults"
it
gives the user a message to say that this worksheet will be excluded and
then
does just that.

At the moment the macro seems to stop running (with no error msg) when it
finds a worksheet that doesn't have the defined range named "GRPResults"
and
does nothing??? What am I doing wrong??

Sub CopyGRPSections()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastRowDest As Long
Dim NewRowDest As Long
Dim LastRowSource As Long
Dim DestLoc As Range
Dim TestRng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("GRP Qtrly Collection").Range("A40:BJ3000").Cells.Clear

Set DestSh = ActiveWorkbook.Worksheets("GRP Qtrly Collection")

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Overview Template" And sh.Name < "GRP Wkly Collection" And
sh.Name < DestSh.Name And sh.Visible = True Then


'''''''''''Where it doesn't find the defined range named "GRPresults" on
the
worksheet it needs to exclude that worksheet and continued through the
others
& complete the code tasks on worksheets it did find


On Error Resume Next
Set TestRng = sh.Range("GRPResults") '''''' Should a defined range name
have "speech marks"?"
On Error GoTo 0

If TestRng Is Nothing Then
MsgBox sh.Name & " worksheet will be excluded"
Else

If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
LastRowDest = 40
Set DestLoc = DestSh.Range("A40")
Else
LastRowDest = DestSh.Range("A" & Rows.Count).End(xlUp).Row
NewRowDest = LastRowDest + 1
Set DestLoc = DestSh.Range("A" & NewRowDest)
End If

LastRowSource = sh.Range("A" & Rows.Count).End(xlUp).Row

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

End If
Exit For

TestRng.Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

End If
End If
Next

Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Thank for your help
BeSmart

I think that you have the Exit For in the wrong place. When the code reaches
the Exit For, it will immediately jump to the line of code after Next.
Therefore the Copy/Paste part of the code will never be executed.

The Exit For should be prior to the End If of the condition that you are
testing to determine if you want the code to proceed. I am not sure but it
appears that it probably should be prior to the End If where I have put the
asterisk line.

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

'******************** 'Exit For maybe here.

End If

Exit For 'Code will always jump to line after Next

testRng.Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

End If
End If
Next


--
Regards,

OssieMac

You dropped a line from the previous suggestion:

Set testrng = nothing
on error resume next
set testrng = sh.Range("GprResults")
on error goto 0

That first Set is very important when you're reusing that variable (like in a
loop).

If the first sheet has that named range and the second doesn't have the name,
then when you're processing the second sheet, the set will fail, but the
variable won't change.

It'll still be whatever it was before--in my example, it'll point at the
(successful) first sheet.

BeSmart wrote:

Hi All

I'm trying to adjust the following code which some amazing experts from this
discussion group have written for me - but (being a novice) I obviously
haven't done it properly...
Your help would be appreciated:

The macro searches all workbooks except "Overview Template", GRP Wkly
Collection, the destination worksheet & hidden worksheets.

It needs to finds all worksheets where the defined range named:
"GRPResults", exists.
For all those worksheets, it copies the GRPResults range, and pastes
values/formats into the destination worksheet - creating a list of data from
all worksheets.

If it finds a worksheet that doesn't have the defined range "GRPResults" it
gives the user a message to say that this worksheet will be excluded and then
does just that.

At the moment the macro seems to stop running (with no error msg) when it
finds a worksheet that doesn't have the defined range named "GRPResults" and
does nothing??? What am I doing wrong??

Sub CopyGRPSections()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastRowDest As Long
Dim NewRowDest As Long
Dim LastRowSource As Long
Dim DestLoc As Range
Dim TestRng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("GRP Qtrly Collection").Range("A40:BJ3000").Cells.Clear

Set DestSh = ActiveWorkbook.Worksheets("GRP Qtrly Collection")

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Overview Template" And sh.Name < "GRP Wkly Collection" And
sh.Name < DestSh.Name And sh.Visible = True Then

'''''''''''Where it doesn't find the defined range named "GRPresults" on the
worksheet it needs to exclude that worksheet and continued through the others
& complete the code tasks on worksheets it did find

On Error Resume Next
Set TestRng = sh.Range("GRPResults") '''''' Should a defined range name
have "speech marks"?"
On Error GoTo 0

If TestRng Is Nothing Then
MsgBox sh.Name & " worksheet will be excluded"
Else

If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
LastRowDest = 40
Set DestLoc = DestSh.Range("A40")
Else
LastRowDest = DestSh.Range("A" & Rows.Count).End(xlUp).Row
NewRowDest = LastRowDest + 1
Set DestLoc = DestSh.Range("A" & NewRowDest)
End If

LastRowSource = sh.Range("A" & Rows.Count).End(xlUp).Row

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

End If
Exit For

TestRng.Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

End If
End If
Next

Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

--
Thank for your help
BeSmart

--

Dave Peterson

Thanks OssieMac

I changed the code and it ran, however it duplicated the data from an
expected 2 worksheets x 6 times?
i.e. it found the first matching worksheet ok and pasted the data
it found the second matching worksheet ok but pasted it's data 5 times...

FYI - Worksheets I currently have (in the order they appear in now):
9 worksheets visible
- GRP Wkly Collection (no defined range name & excluded in code)
- GRP Qtrly Collection (no defined range name & destination sh excluded in
code)
- Overview Template (no defined range name & excluded in code)
* - Test Plan (has the defined range name)
* - Test Plan (2) (has the defined range name)
- Plan Amendments (no defined range name)
- Sampling Opportunities (no defined range name)
- Test Report (no defined range name)
- MBA Report (no defined range name)

I also have 3 worksheets hidden which don't include the defined range name.

* 2 of the visible worksheets have the defined range named "GRPResults"

In addition, the macro seems to reacts differently depending on which
worksheet you start running the macro from (a worksheet with the defined
range name versus one without)...

Do you think that this macro will have problems once the users get hold of
it? (i.e. is volatile in some way).

If yes, then perhaps I should use another easier method e.g. having a "cheat
cell" on the worksheets that contains a word e.g. "GRPResults" which I
include as part follows:

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Overview Template" And sh.Range("A1") = "GRPResults" And
sh.Name < DestSh.Name And sh.Name < "GRP Wkly Collection" And sh.Visible =
True Then

But then I run the risk of a user deleting the text from cell A1 on one of
the worksheets and that data not being included....

--
Any advice???
BeSmart


"OssieMac" wrote:

I think that you have the Exit For in the wrong place. When the code reaches
the Exit For, it will immediately jump to the line of code after Next.
Therefore the Copy/Paste part of the code will never be executed.

The Exit For should be prior to the End If of the condition that you are
testing to determine if you want the code to proceed. I am not sure but it
appears that it probably should be prior to the End If where I have put the
asterisk line.

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

'******************** 'Exit For maybe here.

End If

Exit For 'Code will always jump to line after Next

testRng.Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

End If
End If
Next


--
Regards,

OssieMac

Ok - got it - thanks Dave.
Sorry I was an idiot - and tried to adapt the code a bit, took the wrong
bits out and almost went mad trying to fix my stuff-up.... So much for
paying attention...
Thanks very much for your patience and for the help
BeSmart