continue code in next line

Question

I have the following code:

Sub rangeSelect()

    Dim r1 As Range, r2 As Range, multiAreaRange As Range, lcopytorow As Long
    Worksheets("data").Activate
    Set r1 = Range("c9:i9")
    Set r2 = Range("m9:af9")
    Set multiAreaRange = Union(r1, r2)

    LCopyToRow = 2

    If Range("L9").Value = "yes" Then

        multiAreaRange.Select
        Selection.Copy
        Sheets("drop").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        LCopyToRow = LCopyToRow + 1

        Sheets("data").Select

    End If

End Sub

my purpose is to copy the selected ranges into another worksheet called "drop" only if there is "yes" in each corresponding L column. The code works fine for the first item in the table. However, I would need to duplicate it for the whole table (some 3800 rows). I want to avoid copying the entire row but rather only copy the defined ranges as stated above. I assume I would have to define a loop through which the code can jump along,but I am not sure how to do it. Hope my explanation makes sense, new to vba but learning quickly. Any help would be highly appreciated. Thanks guys.

Answer 1

Please correct me if I misunderstood your question, but I think you only need to index the row number in your definitions:

Dim r1 As Range, r2 As Range, multiAreaRange As Range, copytorow As Long
Worksheets("data").Activate

LCopyToRow = 2

For j = 9 To 3800 'repeat this 3791 times, or use Range("c9").End(xlDown).Row to get the last line as suggested by chancea (definitely more flexible)

    Set r1 = Range("c" & j & ":i" & j)
    Set r2 = Range("m" & j & ":af" & j)
    Set multiAreaRange = Union(r1, r2)

    If Range("L" & j).Value = "yes" Then

        multiAreaRange.Select 
        Selection.Copy
        Sheets("drop").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        LCopyToRow = LCopyToRow + 1

        Sheets("data").Select

    End If

Next j

The above is the same code you had before, but instead of running on line 9 only it's running from line 9 to line 3800 (custom your values as you prefer, of course). Please note I'm assuming the previous code is working fine for line 9, so it is applicable to all the other lines.

EDIT suggested by chancea:

You don't need to select ranges and sheets everytime, it would just make a big useless mess if run over 3800 lines because you would see the screen continuously jumping from one place to the other. But I don't touch the code, I let you update as you prefer.

Answer 2

You are on the right track, you simply need to generalize the example you provided through the use of a for loop and a variable.

For loops basically work like this

For [some variable] = [starting number] to [ending number]
    [Run some code while variable equals current value]
Next

Essentially you will want to wrap your entire code inside a for loop so that it can evaluate each row, one-by-one. The only thing you want outside the loop are your Dim declarations and LCopyToRow = 2 so that they do not reset on each iteration of the loop.

You can set variables by saying something like Dim i as Long. It appears you want to start your for loop by setting i = 9 for the 9th row and looping through to your last row of the original sheet. If the row will be constant you can simply set it to that value, but if it changes making a "lastrow" variable would be a good idea.

For example, the first line within your for loop would be: Set r1 = Sheets("data").Range("c" & i & ":i" & i), and then you would follow a similar format while placing the variable into your other statements.

One other thing I would recommend is declare your sheet in front of your range, as I did in the example above, and then drop the select statements from the code. This can help speed up your code it, keep it cleaner, and help prevent errors. Also it will stop the workbook from flipping back and forth between sheets, which can be annoying if you are watching the process run.

For example, instead of:

multiAreaRange.Select
Selection.Copy
Sheets("drop").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

You could simply say something like:

multiAreaRange.copy destination:=Sheets("drop").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow))

Edit: I have this working for me in a sample workbook:

Sub test()
    Dim r1 As Range, _
    r2 As Range, _
    multiAreaRange As Range, _
    lcopytorow As Long, _
    i As Long

    lcopytorow = 2

    For i = 9 To 100
        Set r1 = Sheets("data").Range("c" & i & ":i" & i)
        Set r2 = Sheets("data").Range("m" & i & ":af" & i)
        Set multiAreaRange = Union(r1, r2)

        If Sheets("data").Range("L" & i).Value = "yes" Then

            multiAreaRange.Copy Destination:=Sheets("drop").Rows(lcopytorow & ":" & lcopytorow)

            lcopytorow = lcopytorow + 1

        End If
    Next

End Sub