VBA - Identify duplicate values in column

[JetSetDrive]

I need assistance with a vba code that will identify duplicate values in a column and copy those cells into a new tab labeled duplicate.

Thank you in advance

 

[DanteAmor]

Try this

The macro creates the "duplicate" sheet

Sub Macro2()
  Dim rn As Range, sh As Worksheet
  Set sh = ActiveSheet
  Set rn = sh.Range("A1", sh.Range("A" & Rows.Count).End(xlUp))
  rn.FormatConditions.AddUniqueValues
  rn.FormatConditions(rn.FormatConditions.Count).SetFirstPriority
  rn.FormatConditions(1).DupeUnique = xlDuplicate
  rn.FormatConditions(1).Interior.Color = 255
  rn.FormatConditions(1).StopIfTrue = False
  sh.Range("A1").AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
  Sheets.Add(, Sheets(Sheets.Count)).Name = "Duplicate"
  sh.AutoFilter.Range.EntireRow.Copy Range("A1")
  Cells.FormatConditions.Delete
  rn.FormatConditions.Delete
  sh.ShowAllData
End Sub

 

[JoeMo]

Here's another macro for you to consider. Assumes you have a header in A1 and values to be checked for duplicates and creates the sheet duplicate.

Sub ExtractDups()
Dim Din As Object, Vin As Variant, Dout As Object, i As Long, ct As Long
Set Din = CreateObject("scripting.dictionary")
Set Dout = CreateObject("scripting.dictionary")
Vin = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For i = 1 To UBound(Vin, 1)
    If Not Din.exists(Vin(i, 1)) Then
        Din.Add Vin(i, 1), ""
    ElseIf Not Dout.exists(Vin(i, 1)) Then
        ct = ct + 1
        Dout.Add Vin(i, 1), ""
    End If
Next i
If ct > 0 Then
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    On Error Resume Next
    Sheets("duplicate").Delete
    On Error GoTo 0
    Sheets.Add after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "duplicate"
        .Range("A2:A" & ct + 1).Value = Application.Transpose(Dout.keys)
        .Range("A1").Value = "Dup Values"
    End With
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
Else
    MsgBox "No duplicates in target range"
End If
End Sub

 

[JetSetDrive]

i appreciate the help with this.

One last thing, the data I am looking for is in column g and I want the other columns and headers brought over as well.

Thank you

 

[DanteAmor]

i appreciate the help with this.

One last thing, the data I am looking for is in column g and I want the other columns and headers brought over as well.

Thank you

Try this

Sub Macro2()
  Dim rn As Range, sh As Worksheet
  Set sh = ActiveSheet
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  Set rn = sh.Range("G1", sh.Range("G" & Rows.Count).End(xlUp))
  rn.FormatConditions.AddUniqueValues
  rn.FormatConditions(rn.FormatConditions.Count).SetFirstPriority
  rn.FormatConditions(1).DupeUnique = xlDuplicate
  rn.FormatConditions(1).Interior.Color = 255
  rn.FormatConditions(1).StopIfTrue = False
  sh.Range("A1:G1").AutoFilter Field:=7, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
  Sheets.Add(, Sheets(Sheets.Count)).Name = "Duplicate"
  sh.AutoFilter.Range.EntireRow.Copy Range("A1")
  Cells.FormatConditions.Delete
  rn.FormatConditions.Delete
  sh.ShowAllData
End Sub

Note: It would help if from the beginning you provide in greater detail what you need, that way we could give you a more complete solution.