Solved Excel Macro Question to Find & Copy whole rows

October 9, 2017 at 09:55:23
Specs: Windows 10
Hi,

I am very new to macros and in need of solution please. So I have over 140,000 rows of data in which column "C" has specific keywords. I would like to create a macro which find if it does contain these keywords would copy it to another spreadsheet.

Example: Column C might say
-Oregon State
-Philadelphia City
-Detroit City

I would like to search for keywords such as "state" or "city" and have them move over to another sheet. I would really appreciate all the help. Thank you

message edited by ayk5473


See More: Excel Macro Question to Find & Copy whole rows

Reply ↓  Report •

#1
October 9, 2017 at 11:44:58
re: "I would like to search for keywords such as "state" or "city""

Does "such as" mean that those are the exact words that you want to search for or are there others?

I ask because just a couple of words could easily be written directly into the code while a longer list of search terms might be better served if they were listed in a range of cells (e.g. Sheet2!A1:A20) and then referenced by the code.

If you could be a little more specific, we could probably offer some code that will meet you requirements.

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


Reply ↓  Report •

#2
October 9, 2017 at 13:02:37
Ok so found out 2 things:

1. I actually have to search in column "D"
2. Keywords I have to search for are "state" "city" "county" "hamlet", "village"," borough", "university"


Reply ↓  Report •

#3
October 9, 2017 at 16:54:05
✔ Best Answer
Try this:

Sub CopyStringRows()
Dim SearchStrings() As Variant
Dim lastRw As Long, nxtRw As Long, arrElement As Long
Dim s As Range, firstAddress As String
'Populate array with search strings
SearchStrings = Array("state", "city", "county", "hamlet", _
                      "village", "borough", "university")
'Determine last row with data in Sheet 1 Column D
 lastRw = Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
'Loop through Array, searching for each string
  For arrElement = 0 To UBound(SearchStrings)
    With Sheets(1).Range("D1:D" & lastRw)
      Set s = .Find(SearchStrings(arrElement), LookIn:=xlValues, lookat:=xlPart)
'If string is found, determine next row in Sheet 2 Column D
'Copy entire row from Sheet 1 to Sheet 2
       If Not s Is Nothing Then
         firstAddress = s.Address
          Do
            nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
            s.EntireRow.Copy Sheets(2).Range("A" & nxtRw)
            Set s = .FindNext(s)
          Loop While Not s Is Nothing And s.Address <> firstAddress
       End If
    End With
  Next
End Sub

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


Reply ↓  Report •
Related Solutions


Ask Question