Reputation: 191
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?
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
Upvotes: 2
Views: 728
Reputation: 1
Create a DROPDOWN list with all names in b1 (by data validation)
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))}
Upvotes: 0
Reputation: 2777
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)
Upvotes: 1