Flagging the latest instance of a duplicate record by way of VBA

[Kiwihiker]

I have a dataset example - see attached. I want to be able to parse the dataset (by VBA, as there may be thousands of records) and determine whether a Product (Column B in the attachment) is unique (i.e. does not occur in any other row in a specific column) or, if not unique, flag if the duplicate is the latest instance based on the highest numeric value within a transaction ID (column D).

In a new column (Column G in the attachment), I would like to return TRUE where a Product is unique (i.e. does not occur in any other record) , OR if it is the latest instance of a Product (based on that numeric portion of the transaction ID). I have manually populated (in Column F) the logical result I would like to achieve by code in Column G.

Otherwise, return FALSE for that record.

I will use this value as part of an INDEX MATCH criteria from another worksheet to report on the latest instance of a given Product (where part of the MATCH will be whether the cell value is TRUE for a given row).

Cheers

Gerry

[#2 · Accepted solution]

@Kiwihiker 

You may try the following code (placed on Module1 in the attached) to flag the Unique/Latest item in column F as you showed in the sample file.

Sub IdentifyUniqueOrLatestRecord()
Dim ws      As Worksheet
Dim x       As Variant
Dim dict    As Object
Dim i       As Long
Dim Trans   As Long
Dim Flag    As Variant

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet1")
x = ws.Range("A1").CurrentRegion.Value
ReDim Flag(1 To UBound(x, 1) - 1, 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x, 1)
    Trans = VBA.Trim(Split(x(i, 4), "-")(1))
    If Not dict.exists(x(i, 2)) Then
        dict.Item(x(i, 2)) = Trans
    Else
        If Trans > dict.Item(x(i, 2)) Then
            dict.Item(x(i, 2)) = Trans
        End If
    End If
Next i

For i = 2 To UBound(x, 1)
    Trans = VBA.Trim(Split(x(i, 4), "-")(1))
    If Trans = dict.Item(x(i, 2)) Then
        Flag(i - 1, 1) = True
    Else
        Flag(i - 1, 1) = False
    End If
Next i

ws.Range("A1").CurrentRegion.Columns(6).Offset(1).ClearContents
ws.Range("F2").Resize(UBound(Flag, 1), 1).Value = Flag

Application.ScreenUpdating = True
End Sub

[#3]

Brilliant - I'll give it a try and let you know how I go; very much appreciated!

[#4]

@Kiwihiker 

Glad it worked as desired.

[#5]

@Subodh_Tiwari_sktneer 

That worked brilliantly. If I can trouble you one more time - I've not played in arrays before, so just want to understand which values to adjust if my real-world workbook uses different column numbers.

I've updated the workbook by creating a new sheet (Sheet 2) by inserting a couple of extra columns (Product is now Column C, TransactionID is now Column F, result is now Column G).

Would you be able to advise how the code would adjust to work with those new columns?

[#6]

@Kiwihiker 

No problem. I have added comments in the code so that you can tweak the code if the layout of your source data gets changed. Let me know if that works as desired.

Sub IdentifyUniqueOrLatestRecord()
Dim wsData  As Worksheet
Dim x       As Variant
Dim dict    As Object
Dim i       As Long
Dim Trans   As Long
Dim Flag    As Variant

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet2")   'Setting Sheet with Data
x = wsData.Range("A1").CurrentRegion.Value
ReDim Flag(1 To UBound(x, 1) - 1, 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x, 1)
    Trans = VBA.Trim(Split(x(i, 6), "-")(1)) 'x(i,6) means Transaction Column F
    If Not dict.exists(x(i, 3)) Then    'x(i,3) means Product Column C
        dict.Item(x(i, 3)) = Trans
    Else
        If Trans > dict.Item(x(i, 3)) Then
            dict.Item(x(i, 3)) = Trans
        End If
    End If
Next i

For i = 2 To UBound(x, 1)
    Trans = VBA.Trim(Split(x(i, 6), "-")(1))
    If Trans = dict.Item(x(i, 3)) Then
        Flag(i - 1, 1) = True
    Else
        Flag(i - 1, 1) = False
    End If
Next i

'Writing output
'Columns(8) means Column H
wsData.Range("A1").CurrentRegion.Columns(6).Offset(1).ClearContents 'Clearing Column H to write the output
wsData.Range("H2").Resize(UBound(Flag, 1), 1).Value = Flag

Application.ScreenUpdating = True
End Sub

[#7]

@Subodh_Tiwari_sktneer 

You Sir are awesome :)

One last question (I promise); if the transaction ID value was a numeric value (i.e. didn't require a split - per sheet 3 in the latest version of the worksheet), what would happen with the SPLIT lines?

[#8]

@Kiwihiker 

For that scenario, you may try the following code...

Remember that this code sets Sheet3 as Sheet with source data.

Sub IdentifyUniqueOrLatestRecord3()
Dim ws      As Worksheet
Dim x       As Variant
Dim dict    As Object
Dim i       As Long
Dim Trans   As Long
Dim Flag    As Variant

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet3")
x = ws.Range("A1").CurrentRegion.Value
ReDim Flag(1 To UBound(x, 1) - 1, 1 To 1)

Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x, 1)
    Trans = x(i, 6)
    If Not dict.exists(x(i, 3)) Then
        dict.Item(x(i, 3)) = Trans
    Else
        If Trans > dict.Item(x(i, 3)) Then
            dict.Item(x(i, 3)) = Trans
        End If
    End If
Next i

For i = 2 To UBound(x, 1)
    Trans = x(i, 6)
    If Trans = dict.Item(x(i, 3)) Then
        Flag(i - 1, 1) = True
    Else
        Flag(i - 1, 1) = False
    End If
Next i

ws.Range("A1").CurrentRegion.Columns(10).Offset(1).ClearContents
ws.Range("J2").Resize(UBound(Flag, 1), 1).Value = Flag

Application.ScreenUpdating = True
End Sub

[#9]

Thank you kind sir :)

[#10]

You're welcome @Kiwihiker! Glad I could help.