D
danldata
I am trying to use a macro from the MS Knowledge base and
it isn't working. the macro is supposed to delete
duplicate records from a list in excel. If anyone knows
how to make this work I'd appreciate it greatly. I'm not
trained on macros or VB and was hoping to plug and play
with minor tweaks to the ranges and sheet number.
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("Sheet3").Range("A1:A7322").Rows.Count
Sheets("Sheet3").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("Sheet3").Cells(iCtr,
1).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet3").Cells
(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet3").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
it isn't working. the macro is supposed to delete
duplicate records from a list in excel. If anyone knows
how to make this work I'd appreciate it greatly. I'm not
trained on macros or VB and was hoping to plug and play
with minor tweaks to the ranges and sheet number.
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("Sheet3").Range("A1:A7322").Rows.Count
Sheets("Sheet3").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("Sheet3").Cells(iCtr,
1).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet3").Cells
(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet3").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