Test named range exists & exclude worksheet if it doesn't
in [Programming]
|
Prev: SendMail
Next: Collating stock market data
From: BeSmart on 28 Feb 2010 23:42 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
From: Per Jessen on 1 Mar 2010 03:43 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" <BeSmart(a)discussions.microsoft.com> skrev i meddelelsen news:8E364F82-8C67-49A2-BD17-A5EFFA52C287(a)microsoft.com... > 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
From: OssieMac on 1 Mar 2010 06:09 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
From: Dave Peterson on 1 Mar 2010 08:44 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
From: BeSmart on 1 Mar 2010 09:22
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 > > |