Copy Duplicate Data In A Column And Paste It To A New Sheet

[orlando606]

Hello

I am a complete novice to VBA and excel. I've done a few things by searching for info and copy and paste. But I am having difficulty extracting duplicate entries in a column mfg# and then copying that row into a separate sheet.

I'm trying to get the duplicates to a separate sheet and then counting how many times their listed using a pivot table.

I'm open to any suggestions that you guru's which to provide.

Thank you in advance.

 

[Kaper]

Why not use Pivot Table from the beginning? Use just MFG# column as a source, then MFG# as rows header and Count of MFG# as values then sort by count? and use only these >1

If you prefer to do it with VBA you can use for instance such approach (may be not the easiest one, but shall be pretty quick, and more over - it is recycled code I prepared just few minutes ago for another therad see: Converting multiple values from columns to rows ):

Sub list_dupes_with_dictionary()
Dim inp_arr, i As Long, out_arr, dict As Object, key As Variant
Set dict = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
  inp_arr = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Value 'if not column C (=3)  or other sheet name - adjust code
End With
For i = 1 To UBound(inp_arr)
  key = CStr(inp_arr(i, 1))
  If dict.Exists(key) Then
    dict(key) = dict(key) + 1
  Else
    dict.Add key, 1
  End If
Next i
For Each key In dict.Keys
    If dict(key) = 1 Then dict.Remove key
Next key
ReDim out_arr(1 To dict.Count, 1 To 2) ' or ... dict.count,1 to 1) to show only names from mfg#, not showing count
For i = 0 To dict.Count - 1
  out_arr(i + 1, 1) = dict.Keys()(i) 
  out_arr(i + 1, 2) = dict.Items()(i) 'in above mentioned case - delete this line
Next i
With Sheets("Sheet2")
  .Cells(2, 1).Resize(dict.Count, 2) = out_arr  ' and use ...dict.count,1)
End With
Set dict = Nothing
End Sub

 

[orlando606]

Kaper,

Morning

That works beautifully.. If i may ask, what would it take to display the entire row on sheet 2 with the count being the last column?

Thanks in advance.

 

[Kaper]

Do you mean that all row, not just column with MFG# is duplicated?

 

[orlando606]

Yes.. That is correct...

 

[Kaper]

Then my idea would probably go other way round:
(idea1 - new macro)
copy all data to new sheet
fill extra column (say AA starting with cell AA2) with formula

=countif(C:C,C2)

copy this column and paste it as values
(optional - sort this extra column on values descending)
filter only values equal 1 in this column
delete visible rows
switch off filter
use remove duplicates

All this can be first recorded and then slightly ammended to take into account possible differences in number of rows in input sheet

or (idea2 - old macro + manual or macro based addition):
use macro from previous post and then either manual or added by macro xlookup function to retrieve all data in given row

 

[orlando606]

I've copied and inserted this code and it works too. Your thoughts?


Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow

Sub main()
Set output = Worksheets("Duplicates")
Set data = Worksheets("MxHistorySummaryMSC")
Set hold = CreateObject("Scripting.Dictionary")

For Each celli In data.Columns(3).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("Duplicates").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub

 

[Kaper]

The code is OK as long as you have few dozens, may be a thousand rows of data. If you have tens or hundreds of thousands of rows, then writing row by row would be rather time consuming process.

And already from the start I'd not check each cell in 3rd column but first I'd skip all empty at from the last entry to the bottom of sheet, so instead of:

For Each celli In data.Columns(3).Cells

I'd use

For Each celli In data.Range("C1:C"&data.cells(rows.count,3).end(xlup).row).Cells

PS. Please note how use of CODE tags (small vba icon in the center of a line above editor window) improves readability of the code

 

[orlando606]

Kaper,

I think I have what I need... Thank you very much for your time and expertise.