locating and separating out duplicates
I hope this is not a dumb question, but I'm not really
sure what to do with this (below). Do I 'step into' a
macro and paste the instructions below, and then run
macro? Or is there somewhere else to input this
information?
Thanks!
Try this for sorting by colour
Sub sortByColour()
Dim iLastCol As Integer, iCellColr As Integer
Dim lLastRow As Long
Dim rCell As Range
lLastRow = Range("A1").End(xlDown).Row
iLastCol = Range("A1").End(xlToRight).Column
Application.ScreenUpdating = False
For Each rCell In Range("A2:A" & lLastRow)
iCellColr = rCell.Interior.ColorIndex
rCell.Offset(0, iLastCol).Value = iCellColr
Next rCell
Range("A1").Sort Key1:=Cells(2, iLastCol + 1),
Order1:=xlAscending, _
Header:=xlGuess
Range("A1").Offset(0, iLastCol).EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
and this to delete duplicates
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
' Loop through records.
For iCtr = 1 To iListCount
' Don't compare against yourself.
' To specify a different column, change 1 to the
column number.
If ActiveCell.Row < Sheets("Sheet1").Cells(iCtr,
1).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet1").Cells
(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet1").Cells(iCtr, 1).Delete
xlShiftUp
' Increment counter to account for deleted
row.
iCtr = iCtr + 1
End If
End If
Next iCtr
' Go to next record.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
.
|