Arrays and duplicates search

[fredrerik84]

Hi guys Ive used all the stuff ive learned over the last 6 months to create this code which basically search for duplicates.

Sub DuplicateSearch()
Dim lr, i, j, k, m  As Long
Dim str As String, str2 As String
Dim vData, vResult As Variant
Dim vSearch, vOdd, vOdd2 As Variant
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("Matches")
lr = sheet.Cells(Rows.Count, "E").End(xlUp).Row
vResult = Range("J12:J" & lr)
vSearch = Range("E12:E" & lr)
vData = sheet.Range("A12:R" & lr)
vSearch = sheet.Range("A12:R" & lr)
   For i = LBound(vData, 1) To UBound(vData, 1)
      m = 0
      str = vData(i, 5)
      If Not IsNull(str) Then
         
         For j = LBound(vData, 1) To UBound(vData, 1)
            str2 = vSearch(j, 5)
            If Not IsNull(str2) Then
               If str = str2 Then
                  m = m + 1
               End If
            End If
         Next j
      End If
      
      If m > 1 Then
         vResult(i, 1) = vData(i, 14)
         Range("J12:J" & lr) = vResult
      End If
   Next i

I was hoping someone could help me finish it as I'm stuck and don't know what to do. This code returns values if I have duplicates matches. as you can see I have it to return data from column N. I would somehow like to manipulate it further so that I can do "x" with the highest value and "Y" with the lower value ..

For now this code just returns the numbers but im not sure what to do next. I really need to compare the values of the duplicated matches ..

Any help would be great..

 

[fredrerik84]

Im close to a solution but my code gets problem when there are more then 2 duplicates..

Sub DuplicateSearch()
Dim lr, i, j, k, m  As Long
Dim str As String, str2 As String
Dim vData, vResult As Variant
Dim vSearch, vOdd, vOdd2 As Variant
Dim sheet As Worksheet
Dim dup1, dup2 As Long
Set sheet = ActiveWorkbook.Sheets("Matches")
lr = sheet.Cells(Rows.Count, "E").End(xlUp).Row
vResult = Range("J12:J" & lr)
vSearch = Range("E12:E" & lr)
vData = sheet.Range("A12:R" & lr)
vSearch = sheet.Range("A12:R" & lr)
   For i = LBound(vData, 1) To UBound(vData, 1)
      m = 0
      str = vData(i, 5)
      vOdd = vData(i, 14)
      If Not IsNull(str) Then
         
         For j = LBound(vData, 1) To UBound(vData, 1)
            str2 = vSearch(j, 5)
            vOdd = vData(j, 14)
            If Not IsNull(str2) Then
               If str = str2 Then
                  m = m + 1
                  k = j
               End If
            End If
         Next j
      End If
      
      If m > 1 Then
         dup1 = k + 11
         dup2 = i + 11
         vResult(i, 1) = vData(i, 5)


         Cells(i + 11, "AB").value = m
         Cells(i + 11, "AA").value = dup1 & dup2
         If dup1 <> dup2 Then
            If vData(i, 14) <> "" Then
               Cells(i + 11, "z").value = "Duplicate"
               Cells(i + 11, "AC").value = vData(i, 14)
               Cells(i + 11, "AD").value = vData(k, 14)
               Cells(i + 11, "N").value = Application.Max(vData(i, 14), vData(k, 14))
               Cells(i + 11, "O").value = Application.Max(vData(i, 15), vData(k, 15))
               Cells(i + 11, "P").value = Application.Max(vData(i, 16), vData(k, 16))
               Range("A" & k + 11 & ":X" & k + 11).value = ""
            End If
         End If
      End If
      m = 0
   Next i
   
End Sub

Anyone see what could be done ?