Solved Column Keyword Search then Copy Row

July 25, 2016 at 00:01:26
Specs: Windows 10
Hi everyone, I want to create a macro that searches for a single keyword in a specific column then cover the whole row on to another work sheet. I found a macro that searches the entire work sheet, but I would like just search within a single column. How do I change the code to search just in one column?

See More: Column Keyword Search then Copy Row

Report •

July 25, 2016 at 00:02:18
Sub NewSheetTODO()
Application.ScreenUpdating = True
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*off*") > 0 Then
Rows(xRow).Copy Sheets("To-Do").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True
End Sub

^that's what i have now.

Thanks for reading.

Report •

July 25, 2016 at 06:26:39
✔ Best Answer
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Thanks!

As for your question, I would not loop through a spreadsheet using the COUNTIF function to determine if a specific string exists. That is very inefficient. Using the Find feature is much more efficient.

I'm also not sure why you are using Application.ScreenUpdating = True at the beginning of the code. Typically it is set to False to have the code run faster.

You didn't say which sheet or column you wanted to search so the following code assumes Sheet1 Column A. Modify as required.

Sub NewSheetTODO()
Dim SrchRng As Range, c As Range
Dim firstAddress As String, lastRw As Long, dstRw As Long
 Application.ScreenUpdating = False
'Search Data in Sheet1 Column A
   With Sheets(1).Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Search for *off*, Copy entire Row for each occurrence to Sheet("To Do")
    Set c = .Find("off", LookIn:=xlValues, lookat:=xlPart)
     If Not c Is Nothing Then
        firstAddress = c.Address
            dstRw = Sheets("To Do").Range("A" & Rows.Count).End(xlUp).Row + 1
              c.EntireRow.Copy Sheets("To Do").Range("A" & dstRw)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
     End If
   End With
 Application.ScreenUpdating = True
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

July 26, 2016 at 19:47:21
Thank you DerbyDad03. That work great. Thank you.

Report •
Related Solutions

Ask Question