Select and Paste Rows in a Different Location

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

En

Super duper repetitive is an understatement!

Every time you select a code block and press Ctrl+C, stop and think twice before you click anywhere else and hit Ctrl+V: copy-pasta code rarely makes anything other than a mess you'll be sorry you have to maintain later on... if you're the one maintaining it. If not, I hope the person that inherits this code isn't a violent psychopath that knows where you live! ;-)


Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. Code for readability.


https://stackoverflow.com/a/878436/1188513

What should happen between your ears when you stop and think twice, is a thought process that goes something like:


How can I avoid duplicating this logic all over the place, write it only once and pass in different parameter values every time I need it?

In this case, it looks like this is your selection when you copy:

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

Each block is assigning some Rn value, where n is a number between 1 and the number of ranges you end up merging. What's that smell? Of course you guessed right, you need looping logic!

You're going to extract a Function from that code block, take your search string as a parameter, and make it return a Range object.

Private Function FindNextBlock(ByVal searchValue As String) As Range

    StartRow = ActiveCell.Row + 1

    Dim searchResult As Range
    Set searchResult = target.Cells.Find(What:=searchValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)

    If searchResult Is Nothing Then Exit Function

    searchResult.Activate
    EndRow = ActiveCell.Row - 1

    Range("A" & StartRow, "O" & EndRow).Select

    Set FindNextBlock = Selection

End Function

I've extracted and assigned a searchResult object variable here, because you have a runtime error 91 (object or with block variable not set) waiting to happen, if the .Find call doesn't find anything. Returning immediately makes the function return Nothing, and the caller can deal with that later.

The caller might be doing something like this at this point:

FindNextBlock("Name")
Set R1 = FindNextBlock("Group Summaries")
Set R2 = FindNextBlock("Name")
Set R3 = FindNextBlock("Group Summaries")
Set R4 = FindNextBlock("Name")
Set R5 = FindNextBlock("Group Summaries")
Set R6 = FindNextBlock("Name")
Set R7 = FindNextBlock("Group Summaries")
Set MultiRange = Union(R1, R2, R3, R4, R5, R6, R7)

...and that's still not it. Everything relies on the initial ActiveCell! That's not a reasonable assumption to make - and that's exactly why working with Selection and ActiveCell (and ActiveSheet) is a major problem. Add another parameter to your function, ByRef currentLocation As Range, and reassign that reference at each call, passing the modified reference to each successive call - and the initial call can take a Range you have complete control over.

That fixes another bug, but doesn't make any loops. The problem is that Union doesn't take an array or a Collection of ranges - it takes ranges that have to be specified one after the other. In other words, you're kinda stuck there.

In an ideal world, you could do this:

Dim currentLocation As Range
Set currentLocation = ActiveCell 'todo: change that

Dim blocks(1 To 8) As String
blocks(1) = "Name"
blocks(2) = "Group Summaries"
blocks(3) = "Name"
blocks(4) = "Group Summaries"
blocks(5) = "Name"
blocks(6) = "Group Summaries"
blocks(7) = "Name"
blocks(8) = "Group Summaries"

For i = 1 To 8
    Set result = FindNextBlock(blocks(i), currentLocation)
    If i > 1 And result Is Not Null Then myRanges.Add result
Next

Set multiRange = Union(myRanges) 'nope

Instead of union-ing them and copying and pasting them all at once, you could have the copy+paste operation as part of the loop. And then there's more abstractions to make - I don't like that array, and I don't like skipping the first one (seems arbitrary)... but that's already way too far from the code you've got here.

StackExchange Code Review Q#93879, answer score: 7