I am working with the output from a chemistry instrument, in .xls format.
The output contains up to seven blocks of data corresponding to different types of samples e.g. controls, unknowns, calibrators, etc... Each block is 15 columns by a variable number of rows, ranging from 3 to 15. The first row contains headers, the leftmost being "Name". The last row is denoted by a cell containing the string "Group Summaries".
My goal is to select the block of cells in between the header row and last row, for each of the seven sample types (R1 to R7). After selecting the blocks I want to join them together (MultiRange) and paste in a different location (not yet decided).
I have written a Sub to accomplish this task however it is super duper repetitive and I would like to know how to shorten it up by creating some sort of loop.
Sub ConsolidateRanges()
Dim R1 As Range, R2 As Range, R3 As Range, R4 As Range, R5 As Range, R6 As Range, R7 As Range, MultiRange As Range
Dim StartRow As Integer, EndRow As Integer
'Selection for Negative Control
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R1 = Selection
'Selection for Positive Control
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R2 = Selection
'Selection for Calibrator
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R3 = Selection
'Selection for Unknown
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R4 = Selection
'Selection for Unknown blank
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R5 = Selection
'Selection for QC
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R6 = Selection
'Selection for QC blank
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
StartRow = ActiveCell.Row + 1
Cells.Find(What:="Group Summaries", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
EndRow = ActiveCell.Row - 1
Range("A" & StartRow, "O" & EndRow).Select
Set R7 = Selection
'Now merge it all together
Set MultiRange = Union(R1, R2, R3, R4, R5, R6, R7)
MultiRange.Select
Selection.Copy
End Sub
This is what the instrument output looks like. The blocks that I want to copy and paste elsewhere are highlighted in green. Each block of data has a row of headers above, and a row with the text "Group Summaries" below.