Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #12  
Old 01-30-2025, 06:02 AM
batman1 batman1 is offline Identify matches between sheet columns Windows 11 Identify matches between sheet columns Office 2013
Advanced Beginner
 
Join Date: Jan 2025
Posts: 57
batman1 is on a distinguished road
Default

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
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
How to Remove the subtotal columns in a sheet Marcia Excel 3 12-01-2023 05:48 AM
Identify matches between sheet columns Relating cells in a row in one sheet to cells in columns on another sheet. mbesspiata3 Excel 2 01-06-2017 05:42 AM
Identify matches between sheet columns Create a New Sheet from Existing Sheet with Specific Columns malam Excel Programming 1 10-17-2014 10:01 PM
Identify matches between sheet columns From an XL sheet ,how to keep the group of columns which match with other XL sheet Zubairkhan Excel 2 03-04-2014 10:57 PM
Removing columns within sheet shabbaranks Excel 2 09-11-2012 05:03 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:05 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft