Macro that will Find, copy, and paste

[Matchis]

Hello,

I have a workbook that has two sheets. On the first sheet is a list of approximately 30 text strings (i.e.: customer is not happy, not negotiable, no one cares, etc). The second sheet has multiple columns from A:EF and approximately 785 rows. The data I am searching for is in column J (Notes) on the second sheet.

I am looking for a macro that will do the following:

1. Copy the headers from the second sheet to a brand new worksheet, then,
2. Search through the second sheet in column J (Notes) for all of the multiple text strings that are listed on the first sheet, then,
3. When a match is found, copy and paste that Entire Row to the brand new worksheet created in step one.

I really appreciate any help provided!!

Thank You all very much!!!!!

 

[JLGWhiz]

One quick question for JLGWhiz,

You added a comment of "edit sheet name", which part do I edit? The "sh1" or the "sheets." Section? The sheet with the list on it is actually called "list" and the 2nd sheet with the data on it is called "notes". Where'd would I substitute?

The number enclosed in parentheses is an index number for the sheets. That number is assigned to your sheets by Excel automatically based on the pecking order from left to right, no matter what the name tab shows. So to be sure that the correct sheets are being referenced by the variables sh1 and sh2, it is wise to use the actural sheet name like Sheets("Sheet1") or Sheets("Data"), etc. When using the sheet name in the parentheses, it must be enclosed in quote marks. The only place you need to make the change is where I have the comments.

My first post includes adding the header to sheet 3.

When you report an error message, be sure you click the debug button and see which line of code is highlighted so you can also include that in your post.

 

[Matchis]

Thank you for getting back to me so quickly, unfortunately that created another issue. I put quotes around them as you advised, but now I get a "Type Mismatch" error. The highlighted line is: Set sh1 = "List".

At least it's a different error, I'm thinking that's progress

 

[JLGWhiz]

The code should be installed in the standard code module 1. Only event code should be entered into sheet code modules or ThisWorkbook code modules as Private Sub procedures. The code I suggested was tested and ran without error during test. If you have merged cells in your file, it could cause copying problems if they are in the copy or paste range. VBA and merged cells don't get along too well in general.

 

[JLGWhiz]

Thank you for getting back to me so quickly, unfortunately that created another issue. I put quotes around them as you advised, but now I get a "Type Mismatch" error. The highlighted line is: Set sh1 = "List".

At least it's a different error, I'm thinking that's progress

Post the code you are trying to run and I will try to edit it.

or try this.

Sub copyNpaste()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range, fn As Range
Set sh1 = Sheets("List")
Set sh2 = sheets("Notes")
Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set sh3 = ActiveSheet
sh2.Rows(1).Copy sh3.[A1]
    For Each c In sh1.Range("*", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("j:j", sh2.Cells(Rows.Count, 10).End(xlUp)).Find(c.Value, , xlValues, xlPart)
        If Not fn Is Nothing Then
            fn.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

 

[Matchis]

Message for JLGWhiz,

The code you provided does not seem to copy the headers. Maybe that's the issue. The headers are on worksheet 2 which contains the information I'm try to find the text strings in column J and copy that row to sheet 3.

 

[Matchis]

This is the code as I hVe it in my workbook:

[COLOR=#333333][FONT=monospace]Sub copyNpaste()Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range, fn As RangeSet sh1 = "List"Set sh2 = "Notes"Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)Set sh3 = ActiveSheetsh2.Rows(1).Copy sh3.[A1]    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))        Set fn = sh2.Range("J2", sh2.Cells(Rows.Count, 10).End(xlUp)).Find(c.Value, , xlValues, xlPart)            If Not fn Is Nothing Then                fn.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)            End If    Next [/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End Sub[/FONT][/COLOR]

Thank You!!!

 

[Matchis]

Wow it ran it all together. It didn't do that before. Let me try again!

 

[Matchis]

Trying to copy code again:

Sub copyNpaste()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range, fn As Range
Set sh1 = "List"
Set sh2 = "Notes"
Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set sh3 = ActiveSheet
sh2.Rows(1).Copy sh3.[A1]
    For Each c In sh1.Range("*", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("j:j", sh2.Cells(Rows.Count, 10).End(xlUp)).Find(c.Value, , xlValues, xlPart)
        If Not fn Is Nothing Then
            fn.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

Hope this one looks better.

 

[JLGWhiz]

I assumed your header was on row 1 of Sheet 2, it so then on this line

sh2.Rows(1).Copy sh3.[A1]

Delete the [A1]
And replace it with
Range("A1")

If the header is on a different row, then you need to advise of what that row is.

 

[JLGWhiz]

Lets get organized here.
1. Have you used the modified code from post #14?
2. If, so what were the results?
3. Did you make the modification recommended in post #19?
4. If, so what were the results?
5. Summarize.