Identify matches between sheet columns

batman1 · #30 02-03-2025, 10:41 AM

1. I tested on Overlay Tool Sample Data BM Ver 1.1.xlsm (Not this file: Overlay Tool Fam Rel Sample Data BM.xlsm) - 11:19 02/02/2025
2. Test
- Firstly click the button to InitiateOverlay --> OVERLAY
- Make the following changes and try again click the button to InitiateOverlay --> OVELAY (1)
- test code

Code:

Sub test()
Dim arr_old(), arr_new(), i As Long, j As Long
arr_old = Worksheets("OVERLAY").Range("A2:L837").value
arr_new = Worksheets("OVERLAY(1)").Range("A2:L837").value
For i = 1 To 836
    For j = 1 To 12
        If arr_old(i, j) <> arr_new(i, j) Then
            Debug.Print i, j
        End If
    Next j
Next i
MsgBox "he he he"
End Sub

both sheets are identical
-------------------------

All changes:

1. In "Sub BuildOverLay" add

Code:

Dim count As Long, i As Long, k As Long

2. Before this fragment

Code:

If Not oFrm.optCreateFam Then
    If lngRecordIndex Then oOS.Range("A2").Resize(lngRecordIndex, lngCols + 1).value = varOverlay_Data
 Else
    If lngRecordIndex Then oOS.Range("A2").Resize(lngRecordIndex, lngCols + 4).value = varOverlay_Data
End If

Paste this fragment

Code:

If oFrm.optCreateFam Then
    oBasicBar.StatusMessage = "Defining Family relationship ... Please Wait"
    For i = 1 To UBound(varOverlay_Data, 1)
        varOverlay_Data(i, lngOS_FamColNum) = min3(varOverlay_Data, lngOS_FamMatchColIndex, varOverlay_Data(i, lngOS_FamMatchColIndex), lngOS_NDSRIColNum)
        If varOverlay_Data(i, lngOS_FamColNum) <> varOverlay_Data(i, 1) Then
'        -----------------------
'           instead of CountIfs - start
            count = 0
            For k = 1 To UBound(varOverlay_Data, 1)
                If varOverlay_Data(k, lngOS_FamMatchColIndex) = varOverlay_Data(i, lngOS_FamMatchColIndex) Then
                    If varOverlay_Data(k, 1) = varOverlay_Data(i, lngOS_ParColNum) Then
                        count = count + 1
                    End If
                End If
            Next k
'           instead of CountIfs - end
'            ---------------------
            If count = 0 Then
                varOverlay_Data(i, lngOS_ParColNum) = varOverlay_Data(i, lngOS_FamColNum)
            End If
        End If
    Next i
End If

3. New version of function min3

Code:

Private Function min3(varOverlay_Data, ByVal lngOS_FamMatchColIndex As Long, ByVal strFamily As String, ByVal lngOS_NDSRIColNum As Long) As String
Dim lngIndex As Integer, rM As Integer
Dim bFirstMatch As Boolean, count As Long, i As Long
    bFirstMatch = True
    rM = varOverlay_Data(1, lngOS_NDSRIColNum)                    '   205
    min3 = varOverlay_Data(1, 1)                          '    ''#2.1
    For lngIndex = 1 To UBound(varOverlay_Data, 1)
        If varOverlay_Data(lngIndex, lngOS_FamMatchColIndex) = strFamily Then       ' 38
            If bFirstMatch Then
                rM = varOverlay_Data(lngIndex, lngOS_NDSRIColNum)   ' 205
                min3 = varOverlay_Data(lngIndex, 1)     '   #2.1
                bFirstMatch = False
            Else
                If rM > varOverlay_Data(lngIndex, lngOS_NDSRIColNum) Then
                    rM = varOverlay_Data(lngIndex, lngOS_NDSRIColNum)     '   204/203
                    min3 = varOverlay_Data(lngIndex, 1)   '   #98.1/#665.1
                End If
            End If
        End If
    Next
'    ------------------------
'    instead of CountIfs - start
    count = 0
    For i = 1 To UBound(varOverlay_Data, 1)
        If varOverlay_Data(i, lngOS_NDSRIColNum) = rM Then count = count + 1
    Next i
'    instead of CountIfs - end
'    ------------------------
    If count > 1 Then
        min3 = varOverlay_Data(1, 1)
        bFirstMatch = True
        For lngIndex = 1 To UBound(varOverlay_Data, 1)
            If varOverlay_Data(lngIndex, lngOS_NDSRIColNum) = rM Then
                If bFirstMatch Then
                    min3 = varOverlay_Data(lngIndex, 1)
                    bFirstMatch = False
                Else
                    If stripNonNums(min3) > stripNonNums(varOverlay_Data(lngIndex, 1)) Then
                        min3 = varOverlay_Data(lngIndex, 1)
                    End If
                End If
            End If
        Next
    End If
lbl_Exit:
  Exit Function

End Function

4. Change to (I added Byval)

Code:

Private Function stripNonNums(ByVal strText As String)

Tomorrow I will write a version of CountIfs using Dictionary

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
Relating cells in a row in one sheet to cells in columns on another sheet.	mbesspiata3	Excel	2	01-06-2017 05:42 AM
Create a New Sheet from Existing Sheet with Specific Columns	malam	Excel Programming	1	10-17-2014 10:01 PM
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