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 (...
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

     

     

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

        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?

  • 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