View Full Version : Solved: Remove Duplicates
kumark
06-05-2013, 11:38 PM
Hi All,
Please Help me finding the Duplicates an attachment has been made with respect to it
Regards
Kumar
patel
06-06-2013, 05:17 AM
select the range then run this macro
Sub NoDupRowsData()
Dim c As Range, cNum As Integer, r As Range, a() As Variant
' Application.ScreenUpdating = False
For Each c In Selection.Rows
cini = c.Column
cNum = c.Columns.Count
Set r = Range(Cells(c.Row, cini), Cells(c.Row, cini + cNum - 1))
r.Select
a() = UniqueRowsVal(r)
r.Clear
r.Resize(1, UBound(a)).Value = a
Next c
' Application.ScreenUpdating = True
End Sub
Public Function UniqueRowsVal(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
oRng.Select
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
colUniques.Add vCell, CStr(vCell)
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0
ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next i
UniqueRowsVal = vUnique
End Function
if problems attach please a sample file, not image
kumark
06-06-2013, 06:14 AM
Hi,
I have Attached the file ,kindly go through it
i executed the macro but showing a error subscript out of range
ReDim vUnique(1 To colUniques.Count)
kindly do look into it.
Thanks in advance for the help
Regards
Kumar
Kenneth Hobs
06-06-2013, 06:24 AM
Sub DeletedupsKen()
Dim a, V, z
With Range("A1", Range("A1").End(xlToRight))
a = .Value
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
'.CompareMode = vbBinaryCompare
For Each V In a
If Not IsEmpty(V) And Not .exists(V) Then .Add V, Nothing
Next
z = .keys
End With
.ClearContents
.Resize(, UBound(z) + 1).Value = z
End With
End Sub
patel
06-06-2013, 11:53 AM
Hi,
i executed the macro but showing a error subscript out of range
ReDim vUnique(1 To colUniques.Count)
did you select the range before macro running ? my code works with your workbook, you can try also this code with ken's sub
Sub NoDupRowsData1()
Dim c As Range, cNum As Integer, r As Range, ar() As Variant
' Application.ScreenUpdating = False
For Each c In Selection.Rows
cini = c.Column
cNum = c.Columns.Count
Set r = Range(Cells(c.Row, cini), Cells(c.Row, cini + cNum - 1))
r.Select
Call DeletedupsRow(r)
Next c
' Application.ScreenUpdating = True
End Sub
Sub DeletedupsRow(theRange As Range)
Dim a, V, z
With theRange 'Range("A1", Range("A1").End(xlToRight))
a = .Value
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
'.CompareMode = vbBinaryCompare
For Each V In a
If Not IsEmpty(V) And Not .exists(V) Then .Add V, Nothing
Next
z = .keys
End With
Stop
.ClearContents
.Resize(, UBound(z) + 1).Value = z
End With
End Sub
kumark
06-06-2013, 09:42 PM
Thanks for the macro its working fine ..Thanks alot
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.