Makro
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 |
Makro
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 |
Makro
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 |
All times are GMT +1. The time now is 05:12 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com