Getting .Find Method to stop at bottom of range (NOT loop around)

[AskMyDog]

Hi all,

Thanks for all of the help previously.

Here's a problem I'm having: I am using the .find method in a Do...While Loop to find duplicate values, but I want the loop to stop when it gets to the bottom of the range, not wrap around and search from the top (another way to put it would be to have it find every instance below the original value, not above). I've tried the following code, but its not looping and finding subsequent duplicates (i.e. it just finding the 2nd duplicate when it enters the Do...Until Loop, but looping back to find the 3rd, 4th, duplicates, etc).

Here's the code:

Sub test()

Dim g As Long
Dim lastRow1 As Long
Dim arr As Variant
Dim h As Long, i As Variant, j As Long
Dim arr1 As Variant
Dim dic As Object
Dim dic2 As Object
Dim Key As String
Dim First_Dupl As Variant
Dim Next_Dupl As Variant
Dim Last_Row As Long
Dim Table3 As ListObject
Dim table_top As Long
Dim Type_Col As Long


Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
dic.RemoveAll
dic2.RemoveAll
Set Table3 = Worksheets("Reconcile Meds Here").ListObjects("Table3")
Table3.Range.ClearFormats
Last_Row = Table3.DataBodyRange.Rows.Count
table_top = Table3.Range.Row


With Worksheets("Reconcile Meds Here").ListObjects("Table3").ListColumns("Medication Type")
arr = .DataBodyRange
For g = 1 To UBound(arr)
If Not IsEmpty(arr(g, 1)) Then
arr1 = Split(arr(g, 1), ", ")
For h = LBound(arr1) To UBound(arr1)
Key = LCase(arr1(h))
dic(Key) = dic(Key) + 1
Next
End If
Next
For Each i In dic
If dic(i) > 1 Then
Set First_Dupl = .Range.Find(i)
j = First_Dupl.Row
With Table3.ListRows(First_Dupl.Row - table_top).Range.Interior
.ColorIndex = 22
.TintAndShade = 0
End With
Do
Set Next_Dupl = .Range.Find(i, after:=First_Dupl)
With Table3.ListRows(Next_Dupl.Row - table_top).Range.Interior
.ColorIndex = 22
.TintAndShade = -0.15
End With
Set First_Dupl = .Range.FindNext
Loop While Not IsNull(First_Dupl) And First_Dupl.Row > j
End If
Next
End With
End Sub

Thanks everyone!

 

[Mohammad Basem]

Hi,

You have two Find statements inside the Do…Loop and depending on the nature of your data it might be possible that the wraparound occurs after Next_Dupl.

Please have a look at the below code (modified from yours) and see if it helps.

[FONT=Consolas][SIZE=2][COLOR=Navy]Do
   Set Next_Dupl = .Range.Find(i, after:=First_Dupl)
   [B]If j = Next_Dupl.Row Or IsNull(Next_Dupl) Then Exit Do[/B]
   With Table3.ListRows(Next_Dupl.Row - table_top).Range.Interior
      .ColorIndex = 22
      .TintAndShade = -0.15
   End With
   Set First_Dupl = .Range.FindNext
   [B]If j = First_Dupl.Row Or IsNull(First_Dupl) Then Exit Do[/B]
Loop[/COLOR][/SIZE][/FONT]