How do i find the last row index of each duplicates within the same column?

user_10508660 0
Viewed 318

I am trying to create a programme such that it can find the last row index of each duplicates that lie within the same column and store their values. For example in the picture, last row index of names with John,trump,alice and sarah should give me 13,17,23,26 respectively. Currently, my code can only identify the duplicates only so what can i do to find the last row index of each duplicate not only for the picture that i showed but also for all cases?

enter image description here

Sub Testing()

    Dim mycell As Range, RANG As Range

    With Sheets(1)

        ' Build a range (RANG) between cell F2 and the last cell in column F
        Set RANG = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))

    End With

    ' For each cell (mycell) in this range (RANG)
    For Each mycell In RANG

        ' If the count of mycell in RANG is greater than 1, then set the value of the cell 1 across to the right of mycell (i.e. column G) as "Duplicate Found"
        If Application.WorksheetFunction.CountIf(RANG, mycell.Value) > 1 Then

        'how do i find the last row index of each duplicate here?

    Next mycell

End Sub
vba excel
2 Answers

Could be done a number of way. Used dictionary object in the code (tested) below. Please add Tool -> Reference -> Microsoft Scripting Runtime.

Sub Testing()
    Dim mycell As Range, RANG As Range, Dict As Dictionary, Mname As String, Rng As Range
    Set Dict = New Dictionary
    With Sheets(1)
        ' Build a range (RANG) between cell F2 and the last cell in column F
        Set RANG = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With


    ' For each cell (mycell) in this range (RANG)
    For Each mycell In RANG
        Mname = mycell.Value
        ' If the count of mycell in RANG is greater than 1, then set the value of the cell 1 across to the right of mycell (i.e. column G) as "Duplicate Found"
        If Application.WorksheetFunction.CountIf(RANG, mycell.Value) > 1 Then


        If Dict.Count > 0 And Dict.Exists(Mname) Then
        Dict(Mname) = mycell.Row()
        Else
        Dict.Add Mname, mycell.Row()
        End If

        End If
    Next mycell


    'Display result in debug window (Modify to your requirement)
    Startrow = 2
    For Each Key In Dict.Keys
    Set Rng = Sheets(1).Range("A" & Startrow & ":A" & Dict(Key))
    Startrow = Dict(Key) + 1
    ' Now may copy etc the range Rng
    Debug.Print Key, Dict(Key), Rng.Address
    Next



End Sub

Code modified to give a range object (as understood from comment)

user_104057780

  1. Create a DROPDOWN list with all names in b1 (by data validation)

  2. In c1 paste the below function (to show the row number of where the last value appears)

{=MAX(($A$1:$A$26=$B$1)*ROW($A$A:$A$226))}
user_78900830
Related