Excel VBA - Loop through a column of cells and search for each cell value in the workbook

Question

I need to create a macro that loops through a list of selected cells containing strings and takes each string and searches the entire workbook for that string. If the string is found, the sub should exit and the found string should be selected otherwise move on to the next string to be found until the end of the list.

When I run my code the sub does not exit when a string in the list is found and it does not go to that cell.

Option Explicit

Dim sheetCount As Integer
Dim datatoFind

Sub Button1_Click()

Find_File

End Sub

Private Sub Find_File()
Dim c As Range
Dim counter As Integer
Dim currentSheet As Integer
Dim notFound As Boolean
notFound = True

For Each c In Selection.Cells
    On Error Resume Next
    currentSheet = ActiveSheet.Index
    datatoFind = StrConv(c.Value, vbLowerCase)
    If datatoFind = "" Then Exit Sub
    sheetCount = ActiveWorkbook.Sheets.Count
    If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
    For counter = 1 To sheetCount
        Sheets(counter).Activate
        Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        If InStr(1, StrConv(ActiveCell.Value, vbLowerCase), datatoFind) Then
            notFound = False
            Sheets(counter).Activate
            Range("datatoFind").Select
            Exit For
        End If
    Next counter
    If notFound = True Then
        MsgBox ("Value not found")
        Sheets(counter).Activate
    Else
        Exit Sub
    End If
Next c
End Sub

Any help is much appreciated!

Answer 1

If was my code I will made different, but just not change dramatic your code

Public Sub Find_File()
Dim c As Range
Dim counter As Integer
Dim currentSheet As Integer
Dim notFound As Boolean
Dim datatoFind As String
Dim sheetCount As Integer
Dim cellFound As Range
Dim cellToFind As Range
Dim originalSheet As Worksheet

notFound = True
Set originalSheet = ActiveSheet
For Each c In Selection.Cells
    On Error Resume Next
    currentSheet = ActiveSheet.Index
    Set cellToFind = c
    datatoFind = StrConv(c.Value, vbLowerCase)
    If datatoFind = "" Then Exit Sub
    sheetCount = ActiveWorkbook.Sheets.Count
    If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
    For counter = 1 To sheetCount
        Sheets(counter).Activate
        Set cellFound = Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        If Not cellFound Is Nothing Then
            If cellFound.Address <> cellToFind.Address And _
               cellFound.Parent.Name <> cellToFind.Parent.Name Then
                notFound = False
                cellFound.Activate
                GoTo WorksEnd
            End If
        End If
    Next counter
Next c
WorksEnd:
    If notFound = True Then
        originalSheet.Activate
        MsgBox ("Value not found")

    End If

End Sub

I hope it help to understand ...

Answer 2

There are a number of problems. The first one is that you are searching through all the sheets. The first match may be in the sheet containing your column of matches !

When looping through the sheets, exclude the sheet containing the column of items to be found...................there are other problems