Hi All 
I have a macro that is working great - it creates an overview by searching 
worksheets for data / coping & pasting values into the overview - but it only 
does it for section of data at the moment. 

I need to do the same actions for nine other sections that use different 
defined range names... 

Should I create 9 macros and link each with "Call XXX"? Or is 
there a way to do this automatically (in one macro) so that I don't need 
9 long macros? 

Here are the steps that already happen in the macro: 

First Run: 

Collect the new data:
The macro clears all old data in all cells on the "collection" worksheet. 

It then searches existing worksheets for a named range "GroupOne" and 
copies/pastes the data found (as values & with formatting) into the 
"collection" worksheet starting at cell A1. 

The results are always within columns (A:BL) but the number of rows will 
vary. 

Update Overview: 
The macro then goes to the "overview template" worksheet and selects the 
defined name range "OverviewfinalGroupOne" (variable range therefore named) 
and clears all old content 

Now it goes back to the collection worksheet to:
select all the "new" data (columns (A:BL) but how many rows will vary)
sort the data - against column G in descending order 
copy and insert the data into the "Overview template" starting at a specific 
point.... 

Currently I've got it starting at cell "A44", but that cell will change 
going forward - I need to insert copied cells into the cell that is in the 
first column, 2nd row down within the named range I'm currently using e.g. 
"OverviewfinalGroupOne". (e.g. if the named range = A43:BL84 it select cell 
A44 & inserts copied 
cells from there)

At this point, I need the macro to do all of the above again - but with the 
following changes: 

Named range GroupOne becomes GroupTwo 
Named range OverviewfinalGroupOne becomes OverviewfinalGroupTwo 
GroupOneRng becomes GroupTwoRng (or can this be "set" again for 2nd run and 
the name re-used??) 

I have to repeat the macro through to GroupNine / OverviewfinalGroupNine 
Then I finish by deleting all unnecessary rows on the Overview Template 
(i.e. delete the row if the cell in column A is blank). 

Here is the current Code with named ranges for the First Run: 
______________
Sub CopyGroupSections() 
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 GroupOneRng As Range 
Dim myRange As Range 
Dim myRange1 As Range 
lastrow = Cells(Rows.Count, "A").End(xlUp).Row 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Sheets("Collection").Cells.Clear 
Set DestSh = ActiveWorkbook.Worksheets("Collection") 
For Each sh In ActiveWorkbook.Worksheets 
If sh.Name <> "Overview Template" And sh.Name <> "GRP Wkly Collection" And 
sh.Name <> "GRP Qtrly Collection" And sh.Name <> DestSh.Name And sh.Visible = 
True Then 
Set GroupOneRng = Nothing 
On Error Resume Next 
Set GroupOneRng = sh.Range("GroupOne") 
On Error GoTo 0 
If GroupOneRng Is Nothing Then 
Else 
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then 
LastRowDest = 1 
Set DestLoc = DestSh.Range("A1") 
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" 
Exit For 
End If 
GroupOneRng.Copy 
With DestLoc 
..PasteSpecial xlPasteValues 
..PasteSpecial xlPasteFormats 
End With 
Application.CutCopyMode = False 
End If 
End If 
Next 
Sheets("Overview Template").Select 
Application.Goto Reference:="overviewfinalGroupOne" 
Selection.ClearContents 
Sheets("Collection").Select 
Range("A1").Select 
Range("A1:BL" & Cells(Rows.Count, "A").End(xlUp).Row).Select 
Selection.Sort Key1:=Range("G1"), Order1:=xlDescending, Header:=xlGuess, _ 
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
Selection.Copy 

Sheets("Overview Template").Select 
Range("A44").Select 
''''The above range needs to change to select the cell in the 1st column and
''''2nd row within the named range (currently using "OverviewfinalGroupOne") 
Selection.Insert Shift:=xlDown 

'''''Repeat the above macro (up to this point) for GroupTwo, 
'''''GroupThree, etc through to GroupNine

Range("A41").Select 
Set myRange = Sheets("Overview Template").Range("A41:A" & lastrow) 
For Each c In myRange 
If UCase(c.Value) = "" Then 
If myRange1 Is Nothing Then 
Set myRange1 = c.EntireRow 
Else 
Set myRange1 = Union(myRange1, c.EntireRow) 
End If 
End If 
Next 
If Not myRange1 Is Nothing Then 
myRange1.Delete 
Range("C17").Select 
End If 
Application.ScreenUpdating = True 
Application.EnableEvents = True 
End Sub 

Any help would be greatly appreciated. 
-- 
Thank for your help
BeSmart

I'd create a sub that does what you want for each group.   something like this

Sub Test(myRangeName as string)

'where you have "GroupOne", change to myRangeName

end sub

If it were me, I'd probably change the range names to 
Group1, Group2, Group3, Group4 

for i = 1 to 9
     Call Test("Group" & i)

next i
-- 
HTH,

Barb Reinhardt



"BeSmart" wrote:

> Hi All 
> I have a macro that is working great - it creates an overview by searching 
> worksheets for data / coping & pasting values into the overview - but it only 
> does it for section of data at the moment. 
> 
> I need to do the same actions for nine other sections that use different 
> defined range names... 
> 
> Should I create 9 macros and link each with "Call XXX"? Or is 
> there a way to do this automatically (in one macro) so that I don't need 
> 9 long macros? 
> 
> Here are the steps that already happen in the macro: 
> 
> First Run: 
> 
> Collect the new data:
> The macro clears all old data in all cells on the "collection" worksheet. 
> 
> It then searches existing worksheets for a named range "GroupOne" and 
> copies/pastes the data found (as values & with formatting) into the 
> "collection" worksheet starting at cell A1. 
> 
> The results are always within columns (A:BL) but the number of rows will 
> vary. 
> 
> Update Overview: 
> The macro then goes to the "overview template" worksheet and selects the 
> defined name range "OverviewfinalGroupOne" (variable range therefore named) 
> and clears all old content 
> 
> Now it goes back to the collection worksheet to:
> select all the "new" data (columns (A:BL) but how many rows will vary)
> sort the data - against column G in descending order 
> copy and insert the data into the "Overview template" starting at a specific 
> point.... 
> 
> Currently I've got it starting at cell "A44", but that cell will change 
> going forward - I need to insert copied cells into the cell that is in the 
> first column, 2nd row down within the named range I'm currently using e.g. 
> "OverviewfinalGroupOne". (e.g. if the named range = A43:BL84 it select cell 
> A44 & inserts copied 
> cells from there)
> 
> At this point, I need the macro to do all of the above again - but with the 
> following changes: 
> 
> Named range GroupOne becomes GroupTwo 
> Named range OverviewfinalGroupOne becomes OverviewfinalGroupTwo 
> GroupOneRng becomes GroupTwoRng (or can this be "set" again for 2nd run and 
> the name re-used??) 
> 
> I have to repeat the macro through to GroupNine / OverviewfinalGroupNine 
> Then I finish by deleting all unnecessary rows on the Overview Template 
> (i.e. delete the row if the cell in column A is blank). 
> 
> Here is the current Code with named ranges for the First Run: 
> ______________
> Sub CopyGroupSections() 
> 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 GroupOneRng As Range 
> Dim myRange As Range 
> Dim myRange1 As Range 
> lastrow = Cells(Rows.Count, "A").End(xlUp).Row 
> Application.ScreenUpdating = False 
> Application.EnableEvents = False 
> Sheets("Collection").Cells.Clear 
> Set DestSh = ActiveWorkbook.Worksheets("Collection") 
> For Each sh In ActiveWorkbook.Worksheets 
> If sh.Name <> "Overview Template" And sh.Name <> "GRP Wkly Collection" And 
> sh.Name <> "GRP Qtrly Collection" And sh.Name <> DestSh.Name And sh.Visible = 
> True Then 
> Set GroupOneRng = Nothing 
> On Error Resume Next 
> Set GroupOneRng = sh.Range("GroupOne") 
> On Error GoTo 0 
> If GroupOneRng Is Nothing Then 
> Else 
> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then 
> LastRowDest = 1 
> Set DestLoc = DestSh.Range("A1") 
> 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" 
> Exit For 
> End If 
> GroupOneRng.Copy 
> With DestLoc 
> .PasteSpecial xlPasteValues 
> .PasteSpecial xlPasteFormats 
> End With 
> Application.CutCopyMode = False 
> End If 
> End If 
> Next 
> Sheets("Overview Template").Select 
> Application.Goto Reference:="overviewfinalGroupOne" 
> Selection.ClearContents 
> Sheets("Collection").Select 
> Range("A1").Select 
> Range("A1:BL" & Cells(Rows.Count, "A").End(xlUp).Row).Select 
> Selection.Sort Key1:=Range("G1"), Order1:=xlDescending, Header:=xlGuess, _ 
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
> Selection.Copy 
> 
> Sheets("Overview Template").Select 
> Range("A44").Select 
> ''''The above range needs to change to select the cell in the 1st column and
> ''''2nd row within the named range (currently using "OverviewfinalGroupOne") 
> Selection.Insert Shift:=xlDown 
> 
> '''''Repeat the above macro (up to this point) for GroupTwo, 
> '''''GroupThree, etc through to GroupNine
> 
> Range("A41").Select 
> Set myRange = Sheets("Overview Template").Range("A41:A" & lastrow) 
> For Each c In myRange 
> If UCase(c.Value) = "" Then 
> If myRange1 Is Nothing Then 
> Set myRange1 = c.EntireRow 
> Else 
> Set myRange1 = Union(myRange1, c.EntireRow) 
> End If 
> End If 
> Next 
> If Not myRange1 Is Nothing Then 
> myRange1.Delete 
> Range("C17").Select 
> End If 
> Application.ScreenUpdating = True 
> Application.EnableEvents = True 
> End Sub 
> 
> Any help would be greatly appreciated. 
> -- 
> Thank for your help
> BeSmart