Iterate Over All Cells That Are Found in Do Until Loop - vba

Question

I am attempting to find duplicated values and in a column in excel and put 3 values in the corresponding columns next to the item. The problem I am struggling with is that my search range is finding the same range over and over again rather than moving on to the next range that's found to contain the string or setting the replaceValuesRange to Nothing.
I subsequently decided to change the string value to MainInputSHeet.Cells(loopCounter, 4).Value = findString & " FOUND" in an attempt to change the value of the string, but I still get stuck in the find loop, which I assume is because the string is still existing within the cell.
Any ideas? The issue exists in the Do Until Loop. Everything else is working fine
This is what the immediate window looks like iterating through the DoLoop:
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
$D$5
Main code block
Option Explicit
Public Const DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH As String = "U:\Research_Dev Docs\DevFolder\SDR Sheet\SDRProductDefinitionsICE.xlsx"
Public Sub TranslateAndPullProductInformation()
Dim lastRow As Integer, loopCounter As Integer
Dim sdrICEDefinitions As Workbook
Dim DefinitionsSheet As Worksheet
Dim findString As String, productTypeString As String, marketTypeString As String, contractTypeString As String
Dim searchRange As Range, findValuesRange As Range, replaceValuesRange As Range
'Checks file exists in specificed path, assigns workbook name, assigns proper worksheet for information definitions
If Len(Dir(DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH)) = 0 Then GoTo BAIL_OUT
Set sdrICEDefinitions = Workbooks.Open(DIR_SDR_PRODUCT_DEFINITIONS_FILEPATH)
Set DefinitionsSheet = sdrICEDefinitions.Sheets(1)
Set searchRange = DefinitionsSheet.Range("A:A")
lastRow = MainInputSheet.Cells(MainInputSheet.Rows.Count, "D").End(xlUp).Row
For loopCounter = 2 To lastRow
If IsEmpty(MainInputSheet.Cells(loopCounter, 3)) = True Then
findString = MainInputSheet.Cells(loopCounter, 4).Value
Set findValuesRange = searchRange.Find(findString)
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).Find(findString)
Do Until replaceValuesRange Is Nothing
'Product Name
MainInputSheet.Cells(loopCounter, 1) = findValuesRange.Offset(0, 1).Value
'Market Type
MainInputSheet.Cells(loopCounter, 2) = findValuesRange.Offset(0, 2).Value
'Contract Type
MainInputSheet.Cells(loopCounter, 3) = findValuesRange.Offset(0, 3).Value
MainInputSheet.Cells(loopCounter, 4).Value = findString & " FOUND"
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext
Debug.Print replaceValuesRange.Address
Loop
End If
Next
Exit Sub
BAIL_OUT:
MsgBox ("ProductDefinitions File not found")
End Sub

Answer 1

Your problem is, that
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext
will start searching from the begging every time. To continue searching (show next occurrence of searched value) you have to use:
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext(replaceValuesRange)
Now the problem is, that the Do Until loop will go infinitely, but for every cell with searched value. I am not sure if there is some smarter way to stop the loop, but I just save row number of first found cell to fstRow variable, and then change StopStop variable for True when the loop will find this first cell once more:
Dim StopStop As Boolean
Dim fstRow As Long
StopStop = False
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).Find(findString)
If Not replaceValuesRange Is Nothing Then fstRow = replaceValuesRange.Row
Do Until replaceValuesRange Is Nothing Or StopStop
Set replaceValuesRange = MainInputSheet.Range(MainInputSheet.Cells(2, 4), MainInputSheet.Cells(lastRow, 4)).FindNext(replaceValuesRange)
If replaceValuesRange.Row = fstRow Then StopStop = True
Loop

Answer 2

I wrote an article recently about Find, but it's in Portuguese, I think it won't help you.
In that article I've put an example code, which you can study and understand how it does work:
Sub FindTest()
Dim Interval As Range
Dim Value As String
Dim Result As Range
Dim PreviousResult As Range
Set Interval = Range("A1:A1000")
Value = "Pedro*"
Set Result = Intervalo.Find(Value, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If Result Is Nothing Then
Debug.Print "Value not found"
Exit Sub
End If
Do
Debug.Print Result.Value
Set PreviousResult = Result
Set Result = Interval.Find(Value, After:=PreviousResult, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
Loop Until Result.Row < PreviousResult.Row
End Sub
It is a good idea to read Find documentation to understand each parameter. I hope that it helps you.

Answer 3

It looks to me like your problem is that you have set replaceValuesRange as a range object. You then use the do loop to run until that range is nothing. The problem is that the range is still an object and will stay an object until you do something else to that variable. I would change this to another for loop and iterate through the range.
Maybe something like
for i = 2 to lastrow 'your variable range starts at row 2 and goes until the last row.
code here
next i