Forum Discussion

Kiwihiker's avatar
Kiwihiker
Copper Contributor
Nov 17, 2021
Solved

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

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

excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Nov 17, 2021

    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

     

     

9 Replies

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Nov 17, 2021

    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

     

     

    • Kiwihiker's avatar
      Kiwihiker
      Copper Contributor
      Nov 17, 2021

      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?

      • Subodh_Tiwari_sktneer's avatar
        Subodh_Tiwari_sktneer
        Silver Contributor
        Nov 17, 2021

        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

         

    • Kiwihiker's avatar
      Kiwihiker
      Copper Contributor
      Nov 17, 2021
      Brilliant - I'll give it a try and let you know how I go; very much appreciated!

Resources