This code works, but it's a seven minute ride.

1858 index numbers listed in column A.

In range C1 to EJ95 I need to find them and move them down 1 row and left 1 column. Each index number appears only once in this range.

Per usual, I struggle making array code work for me.

Thanks,
Howard


Sub ReDoData()
Dim c As Range, spNum As Range
Application.ScreenUpdating = False

With Range("C1:EJ950")
.UnMerge
End With

For Each c In Worksheets("Orginal List").Range("A1:A1858")

Set spNum = Sheets("Orginal List").Range("C1:EJ950") _
.Find(What:=c, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

If Not spNum Is Nothing Then

spNum.Cut spNum.Offset(1, -1)

End If

Next

Application.ScreenUpdating = True
End Sub