View Full Version : Remove Duplicate macro, modify to delete adjacent cell

07-21-2014, 11:03 PM
The below macro removes duplicates in column A and is working fine, what I need it to do is have it delete the corrosponding cell in column B and then move data up as is happening now.

I know it is this line of code that needs amending but not sure how to do this?

Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp

Private Sub Commandbutton1_Click
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("A2:A500").Rows.Count
' 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)(xlToRight).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
Application.ScreenUpdating = True
MsgBox "Duplicate Entries Have Been Deleted!"
End Sub

Thanks for any assistance

07-22-2014, 12:48 AM
Did you try the removeduplicates facility in Excel 2007 / 2010 ?

07-22-2014, 01:11 AM
I only have access to 2003 at work where I use this, remove duplicates facility in Excel 2007 / 2010 this program, I have read about it but with only 2003 not much use to me at the moment.

07-22-2014, 01:24 AM
In that case post a sample of your data and a more efficient approach will appear, like

Sub M_snb()
sn = sheet1.Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 1 To UBound(sn)
If .exists(sn(j, 1)) Then
sn(j, 1) = ""
x0 = .Item(sn(j, 1))
End If
End With

sheet1.Cells(1).CurrentRegion = sn
End Sub

07-22-2014, 01:35 AM
snb that is working fine for column A, but I don't want the entire row deleted as the sheet has other data in it which I don't want deleted.

What I need to happen is when the duplicate is deleted it deletes the adjacent cell in column B, not the entire row.

Is that possible to modify the macro to achieve this.

Thanks for your assistance.

07-22-2014, 03:59 AM
Deleting or clearcontents ?

07-22-2014, 04:52 AM
Well I guess deleting the adjacent data in column B will be ok.


07-22-2014, 05:35 AM
do you know the difference between deleting and 'clearing' ?
Post a sample workbook to illustrate your question.

07-23-2014, 06:09 AM
snb I do known the difference with deleting and clearing the contents, the sheet I want to remove the duplicates from has no formatting at all, it is only a reference sheet to others and also hidden.

I have uploaded a test sheet showing the basic layout, as before I only need to remove dups in column A and the data in the adjacent cell that gets deleted, how is should look after dups removed is on the after sheet.