Instead of
And note that the code doesn't actually work to remove duplicates - and it is really poorly written.
I should have said:
And note that the code doesn't ALWAYS work to remove ALL duplicates - and it is really poorly
written.
One problem is that it needs to decrement the counter, not increment it to account for the deleted
row...
' Increment counter to account for deleted row.
iCtr = iCtr + 1
Should be
'Decrement counter to account for deleted row.
iCtr = iCtr - 1
HTH,
Bernie
MS Excel MVP
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Frdrik,
Your workbook needs to have a sheet named "Sheet1" to have that code not error on that line.
But, that line is the equivalent of this:
iListCount = 100
since
Sheets("Sheet1").Range("A1:A100").Rows.Count
is ALWAYS 100.
And note that the code doesn't actually work to remove duplicates - and it is really poorly
written.
Try this to remove duplicate values (leaving the first instance) from column A
HTH,
Bernie
MS Excel MVP
Sub DeleteRepeatsInColA()
Dim myRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
myRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").EntireColumn.Insert
Range("A1").Value = "Flag"
Range("A2:A" & myRow).Formula = _
"=IF(COUNTIF($B$2:B2,B2)1,""Delete"","""")"
Cells.Sort key1:=Range("A2"), order1:=xlDescending, Header:=xlYes
Range("A1:A" & myRow).AutoFilter Field:=1, Criteria1:="Delete"
Range("A2:A" & myRow).SpecialCells(xlCellTypeVisible).EntireRow.D elete
Range("A:A").EntireColumn.Delete
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
"Fredrik" wrote in message
...
I have copied the makro from microsoft site:
http://support.microsoft.com/kb/291320/sv
But when i tried to start it this message shows:
Run error number 9
Index is out interval.
This line shows in yellow :
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Anyone who knows what the problem are?
I would be very grateful
The makro is
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