Excel VBA Select a Range of Cells Until a Cell Contains Specific Text

Question

I've been able to search the worksheet for a name (Dion in the code below) and copy the row containing the name Dion to a different worksheet. However, the destination worksheet may contain text in the columns adjacent to, and beyond, the last column of text in the source worksheet.

I want to be able to select a range of cells from the row containing Dion, with the selection ending at a cell containing specific text.

I also tried changing If Cells(...).Value = "Dion" Then to If Range("A1:CS1000")... but kept getting a Type Mismatch error.

Here is my VBA code. I know it's probably very inefficient, but it's what I was able to make work:

Dim r As Long
Dim endRow As Long
Dim pasteRowIndex As Long

Worksheets("Tracking").Activate

endRow = 500
pasteRowIndex = 1

For r = 6 To endRow

    If Cells(r, Columns("BM").Column).Value = "Dion" Then

        Rows(r).Select
        'Code above shoud select all cells from Rows(r) until a cell contains the text "End"
        Selection.Copy

        Worksheets("Dion").Select
        Rows(pasteRowIndex + 5).Select
        ActiveSheet.Paste

        pasteRowIndex = pasteRowIndex + 1

        Worksheets("Tracking").Select

    End If

Next r

Thanks for your help.

Off-topic, Cells(r, Columns("BM").Column) you can simply say Cells(r, "BM") — A.S.H

YowE3K YowE3K · Accepted Answer · 2017-04-21T22:57:04

If you are just trying to limit the copy of the row to be the columns up to the one containing a value of "End", the following code should work:

Dim r As Long
Dim endRow As Long
Dim pasteRowIndex As Long
Dim endCell As Range

'Use With block so that we can write '.' instead of 'Worksheets("Tracking").'
With Worksheets("Tracking")

    endRow = 500
    pasteRowIndex = 1

    For r = 6 To endRow
        'Always qualify 'Cells', 'Range', 'Columns' and 'Rows' objects so that we
        'know what sheet we are referring to
        'Also, as pointed out by A.S.H, ' Columns("BM").Column ' can be
        'shortened to ' "BM" '
        If .Cells(r, "BM").Value = "Dion" Then
            'Find, in the current row, the location of the first cell containing "End"
            'Note: If you want to search for the word "End" by itself, rather than just
            '"End" within the cell (e.g. in the value "Endymion"), change "xlPart" to
            '"xlWhole"
            Set endCell = .Rows(r).Find(What:="End", LookIn:=xlValues, LookAt:=xlPart, After:=.Cells(r, "A"))
            If endCell Is Nothing Then
                'If no "End" found, copy the entire row
                .Rows(r).Copy Worksheets("Dion").Rows(pasteRowIndex + 5)
            Else
                'If "End" found, copy from column A to the cell containing "End"
                'Note: I have assumed you don't want to copy the "End" cell itself
                .Range(.Cells(r, "A"), endCell.Offset(0, -1)).Copy Worksheets("Dion").Rows(pasteRowIndex + 5).Cells(1, "A")
            End If

            pasteRowIndex = pasteRowIndex + 1

        End If

    Next r
End With

Excel VBA Select a Range of Cells Until a Cell Contains Specific Text

1 Answers