Macro: Streamline Bulky Macros & Pars a Range of Rows to a New Sheet

[puppetpalace]

Hello! I have been lurking a bit on the forums and have used problem solving from other threads to put together a copy-pasted-Frankenstein macro (I have no prior experience with macros or programming). I am working with a giant excel sheet that contains “data collection points” that have an “On” and an “Off” (e.g.: DataCollection01On, DataCollection01Off, DataCollection02On, DataCollection02Off, etc). What I am attempting to do is pars the data to make it easier for analysis.

What I have created is 4 macros that activate a large number of other macros that do the same repetitive commands, but on different DataCollection# points.
Example:

Sub A_01Insert1AboveRow_Do1Time()
'This Macro will execute all of the Insert Row ABOVE
InsertRowDC01
InsertRowDC02
InsertRowDC03
InsertRowDC04
InsertRowDC05
InsertRowDC06
InsertRowDC07
InsertRowDC08
InsertRowDC09
InsertRowDC10
InsertRowDC11
InsertRowDC12
InsertRowDC13
InsertRowDC14
InsertRowDC15
InsertRowDC16
InsertRowDC17
InsertRowDC18
InsertRowDC19
InsertRowDC20
InsertRowDC21
InsertRowDC22
InsertRowDC23
End Sub

What I have works, but is prone to freezing the Excel program. I was hoping I might be able to get some assistance to streamline what I have done and optimize the usability of my macros. I have attached an Excel file with untouched sample data with the macros included. (I attempted to paste my entire code using the tags, however it went beyond the character limits. Please see my attached file which should contain my code.)
---

Additionally, there are a number of things that I was not able to figure out how to do:

• have each data collection range copy and paste into its own separate sheet
• copy and paste row 1 (data headers) from sheet1 at the top of each newly pasted DataCollection# sheet in the excel file.
• insert 3 blank rows between the row 1 (data headers) and the pasted DataCollection#On row (I am told this is necessary to do quick average/min/max/std.dev. etc formulas at the bottom of certain columns)

If anyone had any tips on this, it would be greatly appreciated. I have also attached a file of how I would ideally like the setup of the excel sheets to appear in case my description was not adequate.

External links to attachment (my files were too large to upload):

http://dl.dropbox.com/u/19746131/Forum_TestData.xlsm - sample data worksheet with the macros
macro_codes.txt - just a text file with the macros if you want to see the full mess

http://dl.dropbox.com/u/19746131/For...orldExcel.xlsm- how my excel data would appear in an "ideal world" with the datacollection points pasting into their own sheet

[puppetpalace]

After more poking around, I think I may have found an answer to the second portion of my post.

Here is a sample of the code if anyone has any thoughts on how this could be streamlined:

Sub A_ParseDCPoints()
'This activates all of the copy-paste macros
ParseSheetDC07
ParseSheetDC06
ParseSheetDC05
ParseSheetDC04
ParseSheetDC03
ParseSheetDC02
ParseSheetDC01

End Sub


Sub ParseSheet01()
'Take the DC01 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON01 As Range, DCOFF01 As Range, i As Long
Set DCON01 = Cells.Find(What:="DataCollection01On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON01 Is Nothing Then: MsgBox "Can't find DataCollection01On": Exit Sub
Set DCOFF01 = Cells.Find(What:="DataCollection01Off")
If DCOFF01 Is Nothing Then: MsgBox "Can't find DataCollection01Off": Exit Sub
'Selects the specified range and copies it
Range(DCON01, DCOFF01).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC01"
ActiveSheet.Name = "DC01"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC01").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC01"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub


Sub ParseSheetDC02()
'Take the DC02 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON02 As Range, DCOFF02 As Range, i As Long
Set DCON02 = Cells.Find(What:="DataCollection02On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON02 Is Nothing Then: MsgBox "Can't find DataCollection02On": Exit Sub
Set DCOFF02 = Cells.Find(What:="DataCollection02Off")
If DCOFF02 Is Nothing Then: MsgBox "Can't find DataCollection02Off": Exit Sub
'Selects the specified range and copies it
Range(DCON02, DCOFF02).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC02"
ActiveSheet.Name = "DC02"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC02").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC02"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub



Sub ParseSheetDC03()
'Take the DC03 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON03 As Range, DCOFF03 As Range, i As Long
Set DCON03 = Cells.Find(What:="DataCollection03On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON03 Is Nothing Then: MsgBox "Can't find DataCollection03On": Exit Sub
Set DCOFF03 = Cells.Find(What:="DataCollection03Off")
If DCOFF03 Is Nothing Then: MsgBox "Can't find DataCollection03Off": Exit Sub
'Selects the specified range and copies it
Range(DCON03, DCOFF03).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC03"
ActiveSheet.Name = "DC03"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC03").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC03"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub

Sub ParseSheetDC04()
'Take the DC04 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON04 As Range, DCOFF04 As Range, i As Long
Set DCON04 = Cells.Find(What:="DataCollection04On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON04 Is Nothing Then: MsgBox "Can't find DataCollection04On": Exit Sub
Set DCOFF04 = Cells.Find(What:="DataCollection04Off")
If DCOFF04 Is Nothing Then: MsgBox "Can't find DataCollection04Off": Exit Sub
'Selects the specified range and copies it
Range(DCON04, DCOFF04).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC04"
ActiveSheet.Name = "DC04"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC04").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC04"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub

Sub ParseSheetDC05()
'Take the DC05 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON05 As Range, DCOFF05 As Range, i As Long
Set DCON05 = Cells.Find(What:="DataCollection05On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON05 Is Nothing Then: MsgBox "Can't find DataCollection05On": Exit Sub
Set DCOFF05 = Cells.Find(What:="DataCollection05Off")
If DCOFF05 Is Nothing Then: MsgBox "Can't find DataCollection05Off": Exit Sub
'Selects the specified range and copies it
Range(DCON05, DCOFF05).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC05"
ActiveSheet.Name = "DC05"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC05").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC05"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub




Sub ParseSheetDC06()
'Take the DC06 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON06 As Range, DCOFF06 As Range, i As Long
Set DCON06 = Cells.Find(What:="DataCollection06On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON06 Is Nothing Then: MsgBox "Can't find DataCollection06On": Exit Sub
Set DCOFF06 = Cells.Find(What:="DataCollection06Off")
If DCOFF06 Is Nothing Then: MsgBox "Can't find DataCollection06Off": Exit Sub
'Selects the specified range and copies it
Range(DCON06, DCOFF06).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC06"
ActiveSheet.Name = "DC06"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC06").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC06"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub


Sub ParseSheetDC07()
'Take the DC07 Range and paste in a new sheet
Sheets("Sheet1").Select   'This selects sheet 1
 'Following sets the range
Dim DCON07 As Range, DCOFF07 As Range, i As Long
Set DCON07 = Cells.Find(What:="DataCollection07On", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If DCON07 Is Nothing Then: MsgBox "Can't find DataCollection07On": Exit Sub
Set DCOFF07 = Cells.Find(What:="DataCollection07Off")
If DCOFF07 Is Nothing Then: MsgBox "Can't find DataCollection07Off": Exit Sub
'Selects the specified range and copies it
Range(DCON07, DCOFF07).EntireRow.Select
Selection.Copy
'Creates new sheet to paste rows and data into
Worksheets.Add(After:=Worksheets(1)).Name = "DC07"
ActiveSheet.Name = "DC07"
Range("A5").Select
ActiveSheet.Paste

'Paste Header and Add a splitscreen between the headers and data
    
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DC07").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    
    ActiveSheet.Name = "DC07"
    Rows("3:3").Select
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 2
    End With


End Sub