find duplicate and update ID number

I have 1000 of rows data in excel and wanted to find the duplicate of the names in all column. if found any same name then it should capture the ID number(from Column A) . So kindly help me in this.

ID P1 P2 P3 P4 P5 if find any name duplicates then capture ID from column A
ID1 Harish Mahesh Ganga Karthik Prashant ID1, ID2
ID2 Jyoti Deepak Jagadish harish Prashanti
ID3 Monika Mahesh Suresh Karthik Deepak ID4
ID4 Swati Deepika Namo JK Monika
ID5 Suresh Dhyan Suresh Mahesh Ganga ID3, ID5
Top Contributor Asked on April 3, 2018 in VBA.
Add Comment
2 Answer(s)

Hello GKJ,  Here is how I view the problem. It may be a bit rudimentary. Please try it.  Thank you.


RE: find duplicate and update ID number


Sub DuplicateRows()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim r As Long
Dim r1 As Long
Dim c As Long
Dim lastrow As Long

On Error GoTo Line1
Application.DisplayAlerts = False
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) _
.Name = “Temp”
Set ws1 = Worksheets(“Sheet1”)
Set ws2 = Worksheets(“Temp”)

lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

r = 2
r1 = 2
c = lastrow
Application.ScreenUpdating = False
ws1.Range(“A1:F” & lastrow).Copy Destination:=ws2.[a1]
ws2.[H1] = “Names”
ws2.[N1] = “Row Numbers”

For i = 1 To lastrow
ws2.Range(Cells(r, r1), Cells(c, r1)).Copy
ws2.Cells(Rows.Count, 8).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
r1 = r1 + 1
Next i
Dim hcol As Long
hcol = ws2.Cells(Rows.Count, 8).End(xlUp).Row

Application.CutCopyMode = False
ActiveSheet.Range(“$H$1:$H” & hcol).RemoveDuplicates Columns:=1, Header:=xlYes
[I2].FormulaR1C1 = “=IFNA(MATCH(RC8,C[-7],0),””””)”
[I2].Copy Destination:=Range(“J2:M2”)

ActiveCell.End(xlDown).Offset(0, 1).Select
Range(ActiveCell, ActiveCell.End(xlUp)).FillDown
For i = 1 To 4
ActiveCell.Offset(0, 1).Select
Range(ActiveCell, ActiveCell.End(xlUp)).FillDown
Next i

ActiveCell.FormulaR1C1 = _
“=CONCATENATE(“”ID “”&RC[-5]&””,””,RC[-4]&””,””,RC[-3]&””,””,RC[-2]&””,””,RC[-1])”

ActiveCell.End(xlDown).Offset(0, 6).Select
Range(ActiveCell, ActiveCell.End(xlUp)).FillDown
hcol = ws2.Cells(Rows.Count, 8).End(xlUp).Row
ws2.Range(“H1:H” & hcol).Copy Destination:=ws1.Range(“H1”)
ws2.Range(“N1:N” & hcol).Copy
ws1.Range(“I1”).PasteSpecial Paste:=xlPasteValues
End Sub

Expert Answered on April 5, 2018.

getting run time error in the following line ——-(  ws2.Range(Cells(r, r1), Cells(c, r1)).Copy)

on April 6, 2018.
  1. Is there a code number associated with the run time error?  Example: Run Time Error 1004
  2. Which excel are you using? 2003, 2007, 2010, 2016 ? – I have tried this code on 2010 and 2016.
  3. In Excel 2010 I had to change:  FormulaR1C1 = “=IFNA(MATCH(RC8,C[-7],0),””””)”
  4. To:                                                              FormulaR1C1 = “=IFERROR(MATCH(RC8,C[-7],0),””””)”
  5. Can you try the code again using a new workbook.
  6. Also make sure that all the Quotation marks are not italicized. Simply replace them if necessary.
on April 6, 2018.
Add Comment

Thank you for looking into this, sure i will check get back to you.

Top Contributor Answered on April 6, 2018.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.