How to find and select multiple rows with macro (excel) ?

Question

How do I search a column for a text and select all columns and rows which match the search text ?

Sample table:

      ColA  ColB  ColC  ColD
Row1        Bob
Row2        Jane
Row3        Joe
Row4        Joe
Row5        Jack
Row6        Jack
Row7        Jack
Row8        Peter
Row9        Susan

So the marco searches for "Jack" then it should select all of Row5-7 in ColA-D.

Answer 1

This isn't as pretty as it could be, but it gets the job done:

Public Sub SelectMultiple()
    Dim wbkthis As Workbook
    Dim shtthis As Worksheet
    Dim rngThis As Range
    Dim rngFind As Range
    Dim firstAddress As String
    Dim addSelection As String


    Set wbkthis = ThisWorkbook
    Set shtthis = wbkthis.Worksheets("Sheet1")

    // Set our range to search
    Set rngThis = shtthis.Range("B2", "B10")

    // Loop through it
    With rngThis

        // Find our required text
        Set rngFind = .Find("Jack")

        // If we find it then...
        If Not rngFind Is Nothing Then
            firstAddress = rngFind.Address // Take a note of where we first found it
            addSelection = addSelection & rngFind.Address & "," // Add the cell's range to our selection

            // Loop through the rest of our range and find any other instances.
            Do
                Set rngFind = .FindNext(rngFind)
                addSelection = addSelection & rngFind.Address & ","
            Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

        End If
    End With

    // Trim the last comma from our string
    addSelection = Mid(addSelection, 1, Len(addSelection) - 1)
    shtthis.Range(addSelection).Rows.Select // Select our rows!

    Set rngThis = Nothing
    Set shtthis = Nothing
    Set wbkthis = Nothing

End Sub

PLEASE NOTE: I've replaced the VBA ' comment with a C# // comment to make this code sample more legible.

Answer 2

I ended up doing something slightly different from my question.

This macro will search on each row in source sheet and copy it to target sheet, which is the parameter. The data does not have to be sorted, but this makes the runtime of the marco longer. You can fix this by comparing previous row searched for a different value than before. The target sheet must exist and any data will be overwritten (not possible to undo!)

Sub Search_SelectAndCopy(sheetname As String)

Dim SheetData As String
Dim DataRowNum As Integer, SheetRowNum As Integer

SheetData = "name of sheet to search in" //' Source sheet
DataRowNum = 2 //' Begin search at row 2
SheetRowNum = 2 //' Begin saving data to row 2 in "sheetname"

//' Select sheetname, as its apparently required before copying is allowed !
Worksheets(SheetData).Select

//' Search and copy the data
While Not IsEmpty(Cells(DataRowNum, 2)) //' Loop until column B gets blank
    //' Search in column B for our value, which is the same as the target sheet name "sheetname"
    If Range("B" & CStr(DataRowNum)).Value = sheetname Then
       //' Select entire row
       Rows(CStr(DataRowNum) & ":" & CStr(DataRowNum)).Select
       Selection.Copy

       //' Select target sheet to store the data "sheetname" and paste to next row
       Sheets(sheetname).Select
       Rows(CStr(SheetRowNum) & ":" & CStr(SheetRowNum)).Select
       ActiveSheet.Paste

       SheetRowNum = SheetRowNum + 1 //' Move to next row

       //' Select source sheet "SheetData" so searching can continue
       Sheets(SheetData).Select
   End If

   DataRowNum = DataRowNum + 1 //' Search next row
Wend

//' Search and copying complete. Lets make the columns neat
Sheets(sheetname).Columns.AutoFit

//' Finish off with freezing the top row
Sheets(sheetname).Select
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub

Remove each pair of // before using.

Answer 3

Hi Kim,

I get an error message, argument not optional

I updated the sheet name to Accounts, changed the 2 ranges first one to b2:s429 and the second range to a2:s2. The name of the sheet I am running the macro from is 49210 which is also in column 2 several times.

Also, how come copy data does not show up on the list of macros... I have to type in the name... like hidden....

I appericate your insight and comments

SR

---

---

Sub copydata(sheetname As String)

Dim SheetData As String

Dim DataRowNum As Integer, SheetRowNum As Integer

SheetData = "Accounts" ' Source sheet DataRowNum = 2 ' Begin search at row 2 SheetRowNum = 2 ' Begin saving data to row 2 in "Sheet 1"

' Select sheetname, as its apparently required before copying is allowed! Worksheets(SheetData).Select

' Search and copy the data

While Not IsEmpty(Cells(DataRowNum, 2)) ' Loop until column B gets blank

' Search in column B for our value, which is the same as the target sheet name "sheetname"

If Range("B2:S429" & CStr(DataRowNum)).Value = sheetname Then

' Select entire row

Rows(CStr(DataRowNum) & ":" & CStr(DataRowNum)).Select Selection.Copy

' Select target sheet to store the data "sheetname" and paste to next row Sheets(sheetname).Select

Rows(CStr(SheetRowNum) & ":" & CStr(SheetRowNum)).Select ActiveSheet.Paste

SheetRowNum = SheetRowNum + 1 ' Move to next row

' Select source sheet "SheetData" so searching can continue Sheets(SheetData).Select End If DataRowNum = DataRowNum + 1 ' Search next row Wend

' Search and copying complete. Lets make the columns neat

Sheets(sheetname).Columns.AutoFit

' Finish off with freezing the top row

Sheets(sheetname).Select Range("A2:S2").Select ActiveWindow.FreezePanes = True End Sub