Dear Jai, Please use below code......
Sub remove_duplicates() Dim s As Range For Each s In Selection s.RemoveDuplicates 1, xlYes Next End Sub -- Thanks & regards, Noorain Ansari *http://noorain-ansari.blogspot.com/* <http://noorain-ansari.blogspot.com/> On Wed, Aug 3, 2011 at 10:28 AM, Jai <jaihumtu...@gmail.com> wrote: > > > > > > HOW CAN REMOVE THE DUPLICATE VALUE IN EXCEL SHEET WITH THIS CODING > > > > > > > > > > > > > > > > > On Wed, Aug 3, 2011 at 5:14 AM, bpascal123 <bpascal...@googlemail.com>wrote: > >> Hi, >> >> This is another code with the same style as above and similar to it, >> this time it highlights instead of delete duplicate values... >> >> I am wondering why these two codes take seconds to execute on about >> 2000 rows when the Excel delete duplicates takes milliseconds... The >> code for highlighting is not equivalent to the Excel function. I >> understand highlighting duplicates values goes from top to bottom, it >> highlights EVERY duplicates values in a column, it's not taking in >> consideration duplicate rows... when the remove duplicate function >> delete duplicate rows... >> >> To sum up, I'm wondering why these code take quite some time? What is >> the "Remove duplicate" function made with? I understand if I use it in >> the code in the first post (I would need more knowledge of Excel >> objects, methods, properties I don't have yet) it would avoid the use >> of looping through the entire data but doing this with an array in >> memory shouldn't take so long??? >> >> >> Option Explicit >> >> Dim TableA() As Variant >> Dim TableB() As Long >> >> Sub HighliteDuplicateValues() >> >> Application.Calculation = xlCalculationManual >> Application.ScreenUpdating = False >> >> Dim wb As Workbook >> Set wb = ThisWorkbook >> Dim ws As Worksheet >> Set ws = wb.Worksheets(1) >> >> Dim wsLastRow As Long, wsLastCol As Long 'worksheet base 1 array >> Dim bigStr As String >> >> ReDim TableA(0, 0) >> Dim TaLastR As Long, TaLastC As Long >> >> ReDim TableB(0) >> Dim TbLastR As Long, TbLastC As Long >> TbLastR = 0 >> >> Dim i As Long, j As Long >> Dim it As Long, jt As Long >> Dim tmp As Long >> Dim x As Variant >> >> Dim markValue As String >> markValue = "---%%%" >> >> 'Copy all values into TableA >> 'Add one more column in TableA to concatenate rows values >> >> wsLastRow = ws.Range("A1").CurrentRegion.Rows.Count >> wsLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column >> >> TaLastR = wsLastRow - 2 >> TaLastC = wsLastCol >> >> ReDim TableA(TaLastR, TaLastC) >> >> For i = 0 To TaLastR >> For j = 0 To TaLastC >> TableA(i, j) = ws.Cells(i + 2, j + 1).Value >> Next j >> For jt = 1 To TaLastC >> bigStr = CStr(bigStr) & CStr(ws.Cells(i + 2, jt)) >> Next jt >> TableA(i, j - 1) = CStr(bigStr) >> bigStr = "" >> Next i >> >> >> 'Count duplicate values from concatenation >> 'Set the tableB dimensions from counting duplicates >> 'Copy row numbers of duplicate values into new table >> >> ReDim Preserve TableA(TaLastR, TaLastC + 1) >> ReDim TableB(TbLastR + 2) >> >> For i = 0 To TaLastR - 1 >> If CStr(TableA(i, TaLastC + 1)) = "" Then >> For j = 0 To TaLastR >> If i <> j Then >> If CStr(TableA(i, TaLastC)) = CStr(TableA(j, TaLastC)) >> Then >> TableA(i, TaLastC + 1) = markValue >> TableA(j, TaLastC + 1) = markValue >> TableB(TbLastR) = i + 2 >> TableB(TbLastR + 1) = j + 2 >> TbLastR = TbLastR + 2 >> ReDim Preserve TableB(TbLastR + 1) >> End If >> End If >> Next j >> End If >> Next i >> >> ReDim Preserve TableB(TbLastR - 1) >> >> '''Test 1 : Mark duplicates on worksheets for comparaison and counting >> >> For i = 0 To TaLastR >> If CStr(TableA(i, TaLastC + 1)) = markValue Then >> ws.Cells(i + 2, 3) = TableA(i, TaLastC + 1) >> End If >> Next i >> >> >> ws.Range("A1").Select >> >> 'Highlight values in worksheet based on row numbers in new table >> >> 'Function to sort >> x = SortArray(TableB) >> >> 'Apply color on duplicate >> For i = 0 To TbLastR - 1 >> tmp = TableB(i) >> ws.Cells(tmp, 1).Interior.Color = 65535 >> >> Next i >> >> Application.Calculation = xlCalculationAutomatic >> Application.ScreenUpdating = True >> >> End Sub >> >> >> Function SortArray(ByRef Table() As Long) As Variant >> Dim tmp As Long >> Dim i As Long, j As Long >> >> For i = 0 To UBound(Table) - 1 >> For j = i + 1 To UBound(Table) - 1 >> If Table(i) > Table(j) Then >> tmp = Table(i) >> Table(i) = Table(j) >> Table(j) = tmp >> End If >> Next j >> Next i >> >> SortArray = Table() >> >> End Function >> >> -- >> >> ---------------------------------------------------------------------------------- >> Some important links for excel users: >> 1. Follow us on TWITTER for tips tricks and links : >> http://twitter.com/exceldailytip >> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 >> 3. Excel tutorials at http://www.excel-macros.blogspot.com >> 4. Learn VBA Macros at http://www.quickvba.blogspot.com >> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com >> >> To post to this group, send email to excel-macros@googlegroups.com >> >> <><><><><><><><><><><><><><><><><><><><><><> >> Like our page on facebook , Just follow below link >> http://www.facebook.com/discussexcel >> > > -- > > ---------------------------------------------------------------------------------- > Some important links for excel users: > 1. Follow us on TWITTER for tips tricks and links : > http://twitter.com/exceldailytip > 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 > 3. Excel tutorials at http://www.excel-macros.blogspot.com > 4. Learn VBA Macros at http://www.quickvba.blogspot.com > 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com > > To post to this group, send email to excel-macros@googlegroups.com > > <><><><><><><><><><><><><><><><><><><><><><> > Like our page on facebook , Just follow below link > http://www.facebook.com/discussexcel > -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel
Copy of REMOVE DUPLICATE(1).xlsx
Description: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
