View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Adam[_6_] Adam[_6_] is offline
external usenet poster
 
Posts: 4
Default 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
.