At the moment we are taking all duplicates in REF_SHEET.
Still the matter of duplicates in column H in NDS_SHEET. At the moment H24 = H25 = DemoData_0000015_Import.zip. The code only takes H24 ("First Match Only"?) so we add to DIC key = filename = "DemoData_0000015_Import.zip", item = i = 24 (row number where "DemoData_0000015_Import.zip" occurs).
If you want 2 results:
<#266912.1><line 24>
<#266912.1><line 25>
you need to add 2 items to DIC:
key = "DemoData_0000015_Import.zip", item = 24
key = "DemoData_0000015_Import.zip", item = 25
In total we take all duplicates in REF_SHEET and all duplicates in H in NDS_SHEET:
#266912.1 <line 24 in NDS_SHEET>
#266912.1 <line 25 in NDS_SHEET>
#77777.1 <line 24 in NDS_SHEET>
#77777.1 <line 25 in NDS_SHEET>
#77777.2 <line 24 in NDS_SHEET>
#77777.2 <line 25 in NDS_SHEET>
So 6 results (3*2) for "DemoData_0000015_Import.zip": 3 duplicates in REF_SHEET and 2 duplicates in NDS_SHEET
Code for this case:
Code:
Option Explicit
Sub demo()
Dim lastRow As Long, pos As Long, i As Long, j As Long, k As Long, count As Long, curr_row As Long, filename As String, key, item, data(), find_data(), result(), dic As Object
With Worksheets("OVERLAY")
' cleaning old results
lastRow = .Cells(Rows.count, "A").End(xlUp).Row
If lastRow > 1 Then .Range("A2").Resize(lastRow - 1, 9).ClearContents
End With
With Worksheets("NDS_SHEET")
lastRow = .Cells(Rows.count, "A").End(xlUp).Row
If lastRow = 4 Then Exit Sub ' there is no data in NDS_SHEET
data = .Range("A5").Resize(lastRow - 4, 8).value ' A:H to data
End With
With Worksheets("REF_SHEET")
lastRow = .Cells(Rows.count, "A").End(xlUp).Row
If lastRow = 1 Then Exit Sub ' there is no data in REF_SHEET
find_data = .Range("A2").Resize(lastRow - 1, 2).value
End With
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
For i = 1 To UBound(data, 1)
filename = data(i, 8) ' column 8 sheet NDS_SHEET
If Not dic.Exists(filename) Then
ReDim item(1 To 1)
' first duplicate row number
item(1) = i
dic.Add filename, item
Else
item = dic.item(filename)
ReDim Preserve item(1 To UBound(item) + 1)
' next duplicate row number
item(UBound(item)) = i
dic.item(filename) = item
End If
Next i
' in case of and duplicates in NDS_SHEET and duplicates in REF_SHEET the result array is the largest
ReDim result(1 To UBound(find_data, 1) * UBound(data, 1), 1 To 9)
For Each key In dic.keys
item = dic.item(key) ' array of duplicate row numbers in column H sheet NDS_SHEET
For i = 1 To UBound(find_data, 1)
pos = InStr(1, find_data(i, 2), key, vbTextCompare)
If pos Then
For k = 1 To UBound(item)
count = count + 1
result(count, 1) = find_data(i, 1)
curr_row = item(k) ' line number in data() with given filename
For j = 1 To 8
result(count, j + 1) = data(curr_row, j)
Next j
Next k
End If
Next i
Next key
If count Then Worksheets("OVERLAY").Range("A2").Resize(count, 9).value = result
Set dic = Nothing
End Sub