PDA

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



Barryj
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
Sheets("Sheet1").Range("A2").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)(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
Loop
Application.ScreenUpdating = True
MsgBox "Duplicate Entries Have Been Deleted!"
End Sub

Thanks for any assistance

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

Barryj
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.

snb
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) = ""
Else
x0 = .Item(sn(j, 1))
End If
Next
End With

sheet1.Cells(1).CurrentRegion = sn
sheet1.Columns(1).SpecialCells(4).EntireRow.Delete
End Sub

Barryj
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.

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

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

Thanks

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

Barryj
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.

Thanks