Duplicating cells from a column

[Amiles]

Hi,

I have looked on this site and have found a lot of posts for duplicating cells when you have dupliactes in a row but not when your trying to duplicate from a column, attached is an example of what I mean

[TABLE="width: 500"]
<TBODY>[TR]
[TD][TABLE="width: 500"]
<TBODY>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]654321[/TD]
[TD]654321[/TD]
[TD]678900[/TD]
[TD]678900[/TD]
[TD]678900[/TD]
[/TR]
[TR]
[TD]765432[/TD]
[TD]876543[/TD]
[TD]765432[/TD]
[TD]876543[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
What I want to do is delete the duplicates out, however its not a simple as other examples as you might have numbers inbetween column A and some are longer duplicates of the numbers than others
[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

 

[texasalynn]

So which option do you want?
1) clear the contents of the cell
2) delete the cell and move the remaining cells to the left

 

[Amiles]

So which option do you want?
1) clear the contents of the cell
2) delete the cell and move the remaining cells to the left

Number 2 please, I hope its all good

 

[texasalynn]

try this

Sub DeleteDuplicates()
Dim LR As Long
Dim LC As Long
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
LC = ActiveSheet.Cells(i, "IV").End(xlToLeft).Column
    For j = LC To 1 Step -1
    RCnt = WorksheetFunction.CountIf(Rows(i), Cells(i, j))
        If RCnt > 1 Then
            Cells(i, j).Delete Shift:=xlToLeft
        End If
    Next j
Next i
MsgBox "Done"
End Sub

 

[Amiles]

Great that has worked thanks so much