Search for a specific string in the whole workbook

[dancer16121983]

Hi. Have a workbook where i log every work i do. i have 12 sheets (one for each month) but sometimes the payment month don't match the sheet. I was wondering if anyone could help me with this. I need a formula or vba code to search the word "February" in every sheet from cell L3 to L80 and return value from corresponding cell B3 to B80 if there's a match. Same for the word "March" and so on. I need to make it so that the results are incremental. If i have matches and the B3 result from the sheet !Jan and the B3 result from the sheet !Feb both exist when i search "February", i want to have all the results. Most formulas only give one result or error in that case. Example: sheet !Jan has 3 matches (L3,L4 and L6) and sheet !Feb has 4 matches (L3,L4,L5 and L6) for the keyword "March"; i want the formula or VBA code to write me 7 lines of results always incrementing what was already written at the above lines. I use a dropdown list to select the month if it helps. Hope you understand my jigsaw :D . Thank you

 

[DanteAmor]

Hi and welcome to MrExcel.

I guess you have a sheet with the drop down list, let's call it "Sheet1".
The macro will search for the word you have in the cell, say "B2", in all the sheets and the list of results will remain on sheet1, say in cell C2 and down.

Try this:

Sub Search_string()
  Dim sh1 As Worksheet, sh As Worksheet, cell As Range
  Dim c As Range, r As Range, f As Range, sAddress As String
  
  Set sh1 = Sheets("Sheet1")
  Set cell = sh1.Range("B2")
  If cell.Value = "" Then
    MsgBox "Fill string"
    Exit Sub
  End If
  For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      Set r = sh.Range("L3:L80")
      Set f = r.Find(cell, , xlValues, xlWhole)
      If Not f Is Nothing Then
        sAddress = f.Address
        Do
          sh1.Range("C" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "B").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
      End If
    End If
  Next
End Sub

 

[dancer16121983]

Thank you. I'll try it and give some feedback later.

 

[dancer16121983]

Thank you very much. After some tweeking and personalisation it is all working. I understand your code and change it to suit my needs and it works flawlessly.

Thank you so much @DanteAmor .

 

[dancer16121983]

Here's an example of how it is right now:

Sub Search_string ()
'
'
'January

  Dim sh1 As Worksheet, sh As Worksheet, cell As Range
  Dim c As Range, r As Range, f As Range, sAddress As String
  
 Set sh1 = Sheets("Data")
  Set cell = sh1.Range("A1")
   If cell.Value = "" Then
    MsgBox "Fill string"
    Exit Sub
     End If
      For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      Set r = sh.Range("L3:L80")
      Set f = r.Find(cell, , xlValues, xlWhole)
      If Not f Is Nothing Then
        sAddress = f.Address
        Do
          sh1.Range("A" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "B").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("B" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "C").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("C" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "D").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("D" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "H").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
      End If
    End If
  Next
  
 'February

 Set sh1 = Sheets("Data")
  Set cell = sh1.Range("E1")
   If cell.Value = "" Then
    MsgBox "Fill string"
    Exit Sub
     End If
  For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      Set r = sh.Range("L3:L80")
      Set f = r.Find(cell, , xlValues, xlWhole)
      If Not f Is Nothing Then
        sAddress = f.Address
        Do
          sh1.Range("E" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "B").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("F" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "C").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("G" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "D").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
         Do
          sh1.Range("H" & Rows.Count).End(xlUp)(2).Value = sh.Cells(f.Row, "H").Value
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> sAddress
       End If
    End If
  Next
End Sub

 

[DanteAmor]

I compacted the macro a bit to work with several cells.
You can put the cells in the array:

Sub Search_string()
  Dim sh1 As Worksheet, sh As Worksheet, cell As Range
  Dim c As Range, r As Range, f As Range, sAddress As String
  Dim lr As Long, ary As Variant, j As Long
 
  Set sh1 = Sheets("Data")
  '       January, February, Etc
  ary = Array("A1", "E1")
  For j = 0 To UBound(ary)
    Set cell = sh1.Range(ary(j))
    If cell.Value = "" Then
      MsgBox "Fill string"
      Exit Sub
    End If
    For Each sh In Sheets
      If sh.Name <> sh1.Name Then
        Set r = sh.Range("L3:L80")
        Set f = r.Find(cell, , xlValues, xlWhole)
        If Not f Is Nothing Then
          sAddress = f.Address
          Do
            lr = cell.Cells(Rows.Count).End(xlUp)(2).Row
            cell.Cells(lr).Offset(, 0).Value = sh.Cells(f.Row, "B").Value
            cell.Cells(lr).Offset(, 1).Value = sh.Cells(f.Row, "C").Value
            cell.Cells(lr).Offset(, 2).Value = sh.Cells(f.Row, "D").Value
            cell.Cells(lr).Offset(, 3).Value = sh.Cells(f.Row, "H").Value
            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> sAddress
        End If
      End If
    Next
  Next
End Sub