Sorry For not mentioned the Macors Sub sameoldcalvin() ' ' Macro3 Macro ' Dim i As Long Dim SearchRange As Range Dim FindRow As Range Dim pp As String Range("G1").Select Start: Do ' Whole process loop counter = do it 9000 times i = i + 1 ActiveCell.Offset(1, 0).Range("A1").Select pp = ActiveCell.Value Set SearchRange = Range("G:G") Set FindRow = SearchRange.Find(pp, LookIn:=xlValues, lookat:=xlWhole) If FindRow.Row = ActiveCell.Row Then GoTo Start Else Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select ActiveCell.Offset(0, 4).Range("A1:B1").Select Selection.Cut ActiveCell.Offset(-1, 0).Range("A1").Select Selection.End(xlToRight).Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste ActiveCell.Offset(1, -2).Range("A1").Select 'delete ActiveCell.Rows("1:1").EntireRow.Select ActiveCell.Activate Selection.Delete Shift:=xlUp ActiveCell.Offset(-1, 3).Range("A1").Select End If Loop Until i = 9000 End Sub