Search text in worksheets + copy to new sheet

Hey,

I've tried searching for an answer to my query but nothing quite works / fits - and I'm not really familiar enough with VBA to edit it enough to make it work.

I have a workbook of many worksheets. Worksheet 1 has a list of names, with a header in row 1 "List", and below it are about 70 rows of alphanumeric one word text. I need to search all the other worksheets (worksheet 2 to the last worksheet) to see if any of those names in worksheet 1 appear. All the worksheets are formatted: column a + b + c + d contain data, row 1 is a header. In worksheet 2 onwards the alphanumeric one word text would appear in a text string in a cell. If they appear, I need to copy the entire row it was found in AND the title of the worksheet it was found in to a new worksheet.

Attached is a template worksheet.

Thanks!!

Hello stonegwene,

Are you searching for whole word matches or partial matches as well?

Hello ,

If your example is true to the original data then a whole word match will not work with the example below:

Name_Symbol=AAAA random info after

The reason is a whole word match expects the word to have a space before and after the word unless it is the first or last word in the string.

Hello stonegwene,

Using a partial match, I can set the macro to add an equal (=) in front of the AAAA and a space after it. But this would work only if the format were always =AAAA .

Hello stonegwene,

Okay, I can do that for you.

Hello stonegwene,

This macro has been attached to a button on "Sheet1". The attached workbook has the macro and button added.

'Thread: http://www.excelforum.com/excel-programming/782555-search-text-in-worksheets-copy-to-new-sheet.html
'Poster: Stonegwene
'Written July 1, 2011
'Author: Leith Ross

Sub SearchForData()

  Dim C As Long
  Dim Cell As Range
  Dim ListWks As Worksheet
  Dim OutWks As Worksheet
  Dim R As Long
  Dim Rng As Range
  Dim SearchRng As Range
  Dim Wks As Worksheet
  
    Set ListWks = Worksheets("Sheet1")
    Set OutWks = Worksheets("Output")
    
    Set Rng = ListWks.Range("A1").CurrentRegion
    
      R = OutWks.Range("A1").CurrentRegion.Rows.Count
      Set Rng = Intersect(Rng, Rng.Offset(1, 0))
    
      For Each Cell In Rng
        For Each Wks In Worksheets
          C = Wks.UsedRange.Columns.Count
          Select Case LCase(Wks.Name)
            Case Is = "sheet1", "output"
              'Do nothing skip these sheets
            Case Else
              Set SearchRng = Wks.Cells.Find(Cell.Value, , xlValues, xlPart, xlByRows, xlNext, False)
              If Not SearchRng Is Nothing Then
                 OutWks.Range("A1").Offset(R, 0) = Wks.Name
                 Set SearchRng = SearchRng.Parent.Cells(SearchRng.Row, 1).Resize(1, C)
                 SearchRng.Copy OutWks.Range("A1").Offset(R, 1).Resize(1, C)
                 R = R + 1
              End If
          End Select
        Next Wks
      Next Cell
      
End Sub