proficient
Well-known Member
- Joined
- Apr 10, 2012
- Messages
- 745
- Office Version
- 2016
- Platform
- Windows
- Mobile
Sub Duplicatevalues()Dim lr As Long, r As Long
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For r = 1 To lr
If Application.WorksheetFunction.CountIf(Range("A:A"), Range("A" & r)) > 1 Then Range("A" & r).Copy Destination:=Range("C" & ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1)
Next r
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
I think you are looking for only duplicates number in one column eg. 1,2,4 etc. right?? or do you need the count also??
Sub Duplicatevalues()
Dim lr As Long, r As Long
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For r = 1 To lr
Range("AA" & r).Value = Application.WorksheetFunction.CountIf(Range("A:A"), Range("A" & r))
If Range("AA" & r).Value > 1 Then Range("A" & r).Copy Destination:=Range("C" & ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1)
Next r
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("AA:AA").ClearContents
End Sub
I want to find duplicates numbers in a range
Duplicates Value
A B C D 1 1 1 4 2 2 2 6 3 3 4 3 4 4 5 6 6 1 7 2 8 2 9 4 10 65 11 1 12 2 13 2 14 4 15 25 16 1 17 2
<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"></colgroup><tbody>
</tbody>
Spreadsheet Formulas
Cell Formula D1 =COUNTIF($A$1:$A$17,C1) D2 =COUNTIF($A$1:$A$17,C2) D3 =COUNTIF($A$1:$A$17,C3)
<tbody>
</tbody>
<tbody>
</tbody>
Excel tables to the web >> Excel Jeanie HTML 4
Numbers | DuplicatesList | Count | Duplicates | |
1 | 1 | 4 | 3 | |
2 | 2 | 6 | ||
3 | 4 | 3 | ||
4 | ||||
6 | ||||
1 | ||||
2 | ||||
2 | ||||
4 | ||||
65 | ||||
1 | ||||
2 | ||||
2 | ||||
4 | ||||
25 | ||||
1 | ||||
2 |
Sub dups()
Dim c
With CreateObject("scripting.dictionary")
For Each c In Range("A1", Cells(Rows.Count, "a").End(3)).Value
.Item(c) = .Item(c) + 1
Next
For Each c In .keys
If .Item(c) = 1 Then .Remove c
Next
Range("C1").Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
End With
End Sub