Copy Duplicate Names to another sheet

[JIGYANSHA1985]

Sir, I would like to copy the Duplicate names (which is at column C ) to another sheet along with corresponding CV Serial Nos which is at Y Column. So that proper verification at that sheet shall be made ... There are many Name only a few samples are provided..

C Column
NAME
----
SUCHANA MOHANTY
DEEPA RANI DASH
SHIBARAM SAHU
BANAJ KUMAR SWAIN
SUVRAJIT JENA
NIRUPAMA BEHERA
SMRUTIMAYA MOHANTY
AKSHAYA KUMAR PRADHAN
BIJAYA LAXMI MOHAPATRA
SAMISKHYA MISHRA
BINODINI BHOLA
MADHUSMITA GOUDA
BANANI KUANR
MOHINI KUMARI BEHERA
MALATI MAHARANA
SHIBARAM SAHU
BANAJ KUMAR SWAIN
SUVRAJIT JENA
NIRUPAMA BEHERA


Y Column
Cv_Serial
---------
193100001
193100002
193100003
193100004
193100005
193100006
193100007
193100008
193100009
193100010
193100011
193100012
193100013
193100014
193100015
193100016
193100017
193100018
193100018

[HansV]

Try this macro:

Code: Select all

Sub CopyDuplicates()
  Dim wshCur As Worksheet
  Dim wshNew As Worksheet
  Dim r As Long
  Dim m As Long
  Dim t As Long
  Set wshCur = ActiveSheet
  Set wshNew = Worksheets.Add
  wshNew.Range("A1") = "Name"
  wshNew.Range("B1") = "CV_Serial"
  t = 1
  m = wshCur.Range("C" & wshCur.Rows.Count).End(xlUp).Row
  For r = 2 To m
    If Application.WorksheetFunction.CountIf _
      (wshCur.Range("C" & r & ":C" & m), wshCur.Range("C" & r).Value) > 1 Then
      t = t + 1
      wshNew.Range("A" & t) = wshCur.Range("C" & r)
      wshNew.Range("B" & t) = wshCur.Range("Y" & r)
    End If
  Next r
  wshNew.Range("A1:B1").EntireColumn.AutoFit
End Sub

[JIGYANSHA1985]

Sir,
The said macro creating New Sheets and within that sheet Field Names are Name & Cv_Serial ...

[HansV]

Yes, so...?

[JIGYANSHA1985]

Sir, By running that macro only field names are created in a sheet, but no duplicates are shown evenif there is...

[HansV]

The code does work with the information that you provided - see the attached workbook.

ListDups.xls

[JIGYANSHA1985]

Thank you very much Sir for providing me this reply within short span of time. It really works well in your sheet ... You are really genius Sir... But Where the CV Serial No. sheet goes, if it reflects corresponding to the name ...

[HansV]

The code copies the name and cv serial number from the same row. Don't they belong together?

[HansV]

I apologize - I hadn't looked closely enough. The names and CV serial numbers do NOT belong together. To treat them separately, change the code as follows:

Code: Select all

Sub CopyDuplicates()
  Dim wshCur As Worksheet
  Dim wshNew As Worksheet
  Dim r As Long
  Dim m As Long
  Dim t As Long
  Set wshCur = ActiveSheet
  Set wshNew = Worksheets.Add
  wshNew.Range("A1") = "Name"
  wshNew.Range("B1") = "CV_Serial"
  t = 1
  m = wshCur.Range("C" & wshCur.Rows.Count).End(xlUp).Row
  For r = 2 To m
    If Application.WorksheetFunction.CountIf _
      (wshCur.Range("C" & r & ":C" & m), wshCur.Range("C" & r).Value) > 1 Then
      t = t + 1
      wshNew.Range("A" & t) = wshCur.Range("C" & r)
    End If
  Next r
  t = 1
  m = wshCur.Range("Y" & wshCur.Rows.Count).End(xlUp).Row
  For r = 2 To m
    If Application.WorksheetFunction.CountIf _
      (wshCur.Range("Y" & r & ":Y" & m), wshCur.Range("Y" & r).Value) > 1 Then
      t = t + 1
      wshNew.Range("B" & t) = wshCur.Range("Y" & r)
    End If
  Next r
  wshNew.Range("A1:B1").EntireColumn.AutoFit
End Sub

[JIGYANSHA1985]

I got Sir, Thanks to you once again...