Search query help required

=PROBLEM SOLVED, thank you DonkeyOte=

Hi there,

I need a macro that can search through all of my worksheets bar the first one looking for the string given by the value of cell (sheet1,A,2). If it finds the string in sheet2 it should fill cell (sheet1,B,2) with the string "True". If found in sheet3, it should fill cell (sheet1,C,2) with "True", etc.

Once it has done this, it should be able to loop and do the same for the string given in (sheet1,A,3), etc.

Looking back on what I've just written I'm not sure how well I've explained myself, so I'll try to convey what I want done in pseudocode:

For each cell (X) in sheet1,column1
        For each worksheet (Y+1) [discounting sheet1]
                 Seach for cellX.Value in sheetY+1
                           If found, sheet1,rowX,columnY+1 = "True"
        Next Y
Next X

Hopefully that'll explain what I want done and hopefully one of you macro-geniuses will be able to help me!

Cheers!

Hi Try this,

Option Explicit

Sub Test()
Dim wsMain As Excel.Worksheet
Dim wsOther As Excel.Worksheet

Dim searchRange As Excel.Range
Dim cl As Excel.Range

' Set main page
Set wsMain = ThisWorkbook.Sheets("Sheet1")
Set searchRange = wsMain.Range("A:A")

For Each wsOther In ThisWorkbook.Sheets
    If Not (wsOther.Name = wsMain.Name) Then
        For Each cl In searchRange
            If GetSeachTextExist(wsOther, cl.Value) Then
                wsMain.Cells(cl.Row, cl.Column + 1) = "True"
            End If
        Next
    End If
Next
End Sub

' Function to search the text
Private Function GetSeachTextExist(wsSearch As Excel.Worksheet, searchText As String) As Boolean
    Dim SearchResult As Excel.Range
    GetSeachTextExist = False
 
    With wsSearch
        Set SearchResult = .Cells.Find(What:=searchText, after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
        
        If Not SearchResult Is Nothing Then
            GetSeachTextExist = True
        End If
    End With
End Function

Regards,
Salim

Hi,

I make some changes in code.

Below is the code,

Option Explicit

Sub Test()
Dim wsMain As Excel.Worksheet
Dim wsOther As Excel.Worksheet

Dim searchRange As Excel.Range
Dim cl As Excel.Range

' Set main page
Set wsMain = ThisWorkbook.Sheets("Sheet1")
Set searchRange = wsMain.Range("A:A")

' Change this set of code
For Each cl In searchRange
    If (cl.Value <> "") Then
        For Each wsOther In ThisWorkbook.Sheets
            If Not (wsOther.Name = wsMain.Name) Then
                If GetSeachTextExist(wsOther, cl.Value) Then
                    wsMain.Cells(cl.Row, cl.Column + 1) = "True"
                    Exit For
                End If
            End If
        Next
    Else
        Exit For
    End If
Next

End Sub

' Function to search the text
Private Function GetSeachTextExist(wsSearch As Excel.Worksheet, searchText As String) As Boolean
    Dim SearchResult As Excel.Range
    GetSeachTextExist = False
 
    With wsSearch
        Set SearchResult = .Cells.Find(What:=searchText, after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
        
        If Not SearchResult Is Nothing Then
            GetSeachTextExist = True
        End If
    End With
End Function

Regards,
Salim

Here is another variant on the same theme....

Public Sub Example()
Dim wsMain As Worksheet, wsOther  As Worksheet, rngCell As Range, bFound As Boolean
For Each rngCell In ActiveSheet.Range(Cells(2, "A"), Cells(Rows.Count, "A").End(xlUp)).Cells
    If LenB(rngCell.Value) Then
        For Each wsOther In ThisWorkbook.Sheets
            If Not wsOther.Name = ActiveSheet.Name Then
                With wsOther: bFound = Not .Cells.Find(rngCell.Value, lookat:=xlWhole) Is Nothing: End With
                If bFound Then rngCell.Offset(, 1).Value = CStr(bFound): Exit For
            End If
        Next wsOther
    End If
Next rngCell
End Sub