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!!!!!

 

[Matchis]

I have the code on the Module 1
I assigned it to a button on worksheet 1 (List) to run the macro
When I click on the button or when I open Macros and try to run the macro I still get Compile Error - Type Mismatch on the following line: Set sh1 = "LIST"
There are no merged cells in the entire worksheet.

I closed everything down because sometimes that solves "issues", however, when I restarted and tried to run the macro the way it sets: I received this error:

Compile error in hidden module: RibbonX_Callbacks. This error commonly occurs when code is incompatible with the version, platform, or architecture of this application.

Not even sure what this means!!

 

[Matchis]

Here is my code with those modifications #14 and #19 completed

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.Range(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

The results now after I shut down and started it up again is this:

Run-time error '1004': Method 'Range"of object' _Worksheet' failed

Different again!

 

[Matchis]

I did notice that it does not exactly copy the headers to the 3rd worksheet - it creates a forth worksheet at the bottom named sheet 4 and it is blank. That's where it stops!

 

[JLGWhiz]

Do not re-type this code into your code module. Copy it from the web and paste it into the code module.

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.Range("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
End Sub

there were a couple of typos that were causing the problem. copying and pasting the code eliminates the typos, except those that the code writer makes. I make enough for both of us.

Re. your post #23- Excel controls the sheet numbering of added sheets and it will increment by one to the last number on the name tabs for the first iteration and will add one more every time you run the code thereafter. So even if you delete the sheet and then re-run the code, it still adds one to the last sheet number it used until you clode the file without saving and start again. Be careful about closing without saving or you could lose your code. The first thing you should do when you put your code in is save the file so you don't lose the code.

 

[Matchis]

OMG - That worked perfectly!!!! Thank you so much!!!

I do have one other very small request!! Can you tell me how to make the test strings highlighted when it copies to the new page? There is so much data, I can't see them without reading every word. And there is a lot!!

 

[Matchis]

Do you think this coding would work? I've put it in a few placed in the existing code, but it does not highlight anything:

Set RngOut = .Characters.Last
 RngOut.Paste
 ' RngOut.HighlightColorIndex = wdTurquoise

Thanks again for all of your help! You've have worked a small miracle!!

 

[JLGWhiz]

OMG - That worked perfectly!!!! Thank you so much!!!

I do have one other very small request!! Can you tell me how to make the test strings highlighted when it copies to the new page? There is so much data, I can't see them without reading every word. And there is a lot!!

Since you are expanding beyond your original post, according to posting guidelines you should start a new thread. I suggest that you do that and post the code you are currently using while clearly stating your additional objective.

 

[Matchis]

I opened a new thread for the highlighting - thanks for letting me know!! Thanks again for all of your help - I really appreciated it!!

 

[JLGWhiz]

I opened a new thread for the highlighting - thanks for letting me know!! Thanks again for all of your help - I really appreciated it!!

You're welcome,
Regards, JLG