How can i fix my loop, so that all matches are found?-CodePudding

My code does this. It search for the word: "KENNFELD" in my current sheet. Then it sets the variable label to the cell that is one to the right of "KENNFELD". Now i want to find matches of the variable label in my whole workbook, excluding the one i am currently on, because that is where i got them in the first place.

The problem is, that this works for the first label that is found, but not for the other ones, and i know for a fact that there has to be 6 more matches. I believe my problem is within the loops, but i can't locate it. Anybody has an idea?

Dim helpc As Range
Dim label As Range
Dim firstAddress As String
Dim foundCell As Range

With Sheets("C7BB2HD3IINA_NRM_X302")
Set helpc = .Cells.Find(what:="KENNFELD", MatchCase:=True)
Set label = helpc.Offset(0, 1) ' assign the value of the cell to label
If Not helpc Is Nothing Then
    firstAddress = helpc.Address
    Do
        For Each ws In ThisWorkbook.Sheets
            If ws.Name <> "C7BB2HD3IINA_NRM_X302" Then
                Set foundCell = ws.Cells.Find(what:=label.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                                              MatchCase:=True)
                If Not foundCell Is Nothing Then
                    MsgBox "Label " & label.Value & " found on sheet " & ws.Name
                End If
            End If
        Next ws
        Set helpc = .Cells.FindNext(helpc)
    Loop While Not helpc Is Nothing And helpc.Address <> firstAddress
End If
End With

CodePudding user response：

I think this does what you want. As stated above, the loop was referencing the wrong Find as far as I can see.

I'm not sure what the purpose is of this code as all it does is show a message box with the same value and the sheet name?

Sub x()

Dim helpc As Range
Dim label As Range
Dim firstAddress As String
Dim foundCell As Range, ws As Worksheet

Set helpc = Sheets("C7BB2HD3IINA_NRM_X302").Cells.Find(what:="KENNFELD", MatchCase:=True)
If Not helpc Is Nothing Then
    Set label = helpc.Offset(0, 1) 'this should be after the line above in case the value is not found which would cause an error
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "C7BB2HD3IINA_NRM_X302" Then
            Set foundCell = ws.Cells.Find(what:=label.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not foundCell Is Nothing Then
                firstAddress = foundCell.Address
                Do
                    MsgBox "Label " & label.Value & " found on sheet " & ws.Name
                    Set foundCell = ws.Cells.FindNext(foundCell)
                Loop While foundCell.Address <> firstAddress
            End If
        End If
    Next ws
End If

End Sub

CodePudding user response：

Find Found Values

Option Explicit

Sub FindLabels()

    Const DST_NAME As String = "C7BB2HD3IINA_NRM_X302"
    Const DST_SEARCH_STRING As String = "KENNFELD"
    Const DST_COLUMN_OFFSET As Long = 1
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    If dws.FilterMode Then dws.ShowAllData
    Dim drg As Range: Set drg = dws.UsedRange
    Dim dlCell As Range
    Set dlCell = drg.Cells(drg.Rows.Count, drg.Columns.Count)
    
    Dim dCell As Range: Set dCell = drg.Find( _
        DST_SEARCH_STRING, dlCell, xlFormulas, xlWhole, xlByRows, , True)
    
    If dCell Is Nothing Then
        MsgBox "Could not find """ & DST_SEARCH_STRING & """ in worksheet """ _
            & DST_NAME & """ of workbook """ & wb.Name & """.", vbCritical
        Exit Sub
    End If
    
    Dim durg As Range: Set durg = dCell.Offset(, DST_COLUMN_OFFSET)
    Dim dFirstAddress As String: dFirstAddress = dCell.Address
    
    Do
        Set durg = Union(durg, dCell.Offset(, DST_COLUMN_OFFSET))
        Set dCell = drg.FindNext(dCell)
    Loop Until dCell.Address = dFirstAddress
    
    Dim sws As Worksheet, srg As Range, slCell As Range, sCell As Range
    Dim sFirstAddress As String, Label
    
    For Each sws In wb.Worksheets
        If StrComp(sws.Name, DST_NAME, vbTextCompare) <> 0 Then
            If sws.FilterMode Then sws.ShowAllData
            Set srg = sws.UsedRange
            Set slCell = srg.Cells(srg.Rows.Count, srg.Columns.Count)
            For Each dCell In durg.Cells
                Label = dCell.Value
                Set sCell = srg.Find( _
                    Label, slCell, xlFormulas, xlWhole, xlByRows, , True)
                If Not sCell Is Nothing Then ' label found in current worksheet
                    sFirstAddress = sCell.Address
                    Do
                        MsgBox "Label """ & CStr(Label) & """ found in Cell " _
                            & """" & sCell.Address(0, 0) & """ of worksheet " _
                            & """" & sws.Name & """.", vbInformation
                        Set sCell = srg.FindNext(sCell)
                    Loop Until sCell.Address = sFirstAddress
                'Else ' label not found in current worksheet; do nothing
                End If
            Next dCell
        'Else ' it's the destination worksheet; do nothing
        End If
    Next sws
        
End Sub