Hi all Experts,
Below is the code I produced following my learning of vba for Excel
from excelvbasql.com. I would like to know if there is anything to be
done about this code. I'm looking to learn from anyone who can share
his/her experience.
Cheers,
Option Explicit
Sub DeleteDupl2()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("sheet1")
Dim lastr As Long, lastc As Long
Dim i As Integer, j As Integer
Dim icopy As Integer
Dim Table() As Variant 'Array for all values
Dim TableOK() As Variant 'Array for unique values
Dim iOkSize As Integer, jOkSize As Integer 'Rows and column size
for TableOK
Dim iOK As Integer, jOk As Integer
Dim idD As String 'to concatenate all values in a rows
Dim idj As Integer 'loop variable to concatenate idD string
Dim deleteSt As String
deleteSt = "---%%%"
lastr = ws.Cells(Rows.Count, 1).End(xlUp).Row
lastc = ws.Range("A1").End(xlToRight).Column
ReDim Table(lastr - 2, lastc)
ReDim TableOK(0, 0)
'''Copy data into Array Table
'''Concatenate column values into an addito
For i = 2 To lastr
For j = 0 To lastc - 1
Table(i - 2, j) = ws.Cells(i, j + 1)
Next j
For idj = 1 To lastc
idD = CStr(idD) & CStr(ws.Cells(i, idj))
Next idj
Table(i - 2, j) = CStr(idD)
idD = ""
Next i
'''mark duplicates but keep untouched the original value
For i = 0 To lastr - 2
j = lastc
idD = Table(i, j)
For j = i + 1 To lastr - 2
If CStr(Table(j, lastc)) = CStr(idD) And
Right(CStr(Table(j, lastc)), 6) <> "---%%%" Then
Table(j, lastc) = CStr(Table(j, lastc)) & "---%%%"
End If
Next j
Next i
Range(ws.Cells(2, 1), ws.Cells(lastr, lastc)).ClearContents
'''Count unique values in Table
For i = 0 To lastr - 2
If CStr(Right(Table(i, lastc), 6)) <> deleteSt Then
iOkSize = iOkSize + 1
End If
Next i
iOkSize = iOkSize - 1
jOkSize = lastc
ReDim TableOK(iOkSize, jOkSize)
''Copy unique values into TableOK"
For i = 0 To lastr - 2
If CStr(Right(Table(i, lastc), 6)) <> deleteSt Then
For j = 0 To lastc
TableOK(iOK, jOk) = Table(i, j)
jOk = jOk + 1
Next j
iOK = iOK + 1
jOk = 0
End If
Next i
''Copy unique values in worksheet
For i = 0 To iOkSize
For j = 0 To jOkSize - 1
ws.Cells(i + 2, j + 1) = TableOK(i, j)
Next j
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
--
----------------------------------------------------------------------------------
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
