Sub k1() For i = 1 To [a65535].End(xlUp).Row s1 = CStr(Cells(i, "A")) Cells(i, "B") = Right(s1, Len(s1) - 1) Cells(i, "C") = Left(s1, Len(s1) - 1) Next i MsgBox 1 For i = [a65535].End(xlUp).Row To 2 Step -1 For j = i - 1 To 1 Step -1 If Cells(i, "b") = Cells(j, "b") Then Cells(i, "b").Delete Shift:=xlShiftUp Exit For End If Next j Next i MsgBox 2 For i = [a65535].End(xlUp).Row To 2 Step -1 For j = i - 1 To 1 Step -1 If Cells(i, "C") = Cells(j, "C") Then Cells(i, "C").Delete Shift:=xlShiftUp Exit For End If Next j Next i End Sub