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
REMOVE DUPLICATE.xlsx
Description: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
