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

Question

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

Answer 1

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.AutoFilterMode Then dws.AutoFilterMode = False
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.AutoFilterMode Then sws.AutoFilterMode = False
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