Looks up a number from sheet 1, Column A in Sheet 2 Column E, and posts offsets from both the left and right of that Col E number back to Column A.

Once the post has been completed the worksheet/book freezes and offers a not responding massage. Restart of Excel is required.

The commented out code works okay until a Column A number does not exist in Sheet 2 Column E, and the posts back to sheet 1 are posted wrong because of the .End(xlUp)(2).

Thanks.
Howard

Option Explicit

Sub ListNewPN()

Dim rngPN As Range
Dim c As Range, i As Range
Dim ws1Part_Num As Range
Dim ws2From_Item As Range

Set ws1Part_Num = Sheets("Sheet1"). _
Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

Set ws2From_Item = Sheets("Sheet2"). _
Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)

For Each c In ws1Part_Num

Set rngPN = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)

If Not rngPN Is Nothing Then

For Each i In ws1Part_Num

If i = rngPN Then
i.Offset(0, 1) = rngPN.End(xlToRight)
i.Offset(0, 2) = rngPN.End(xlToLeft)
End If

'Sheets("Sheet1").Range("B100").End(xlUp)(2) _
= rngPN.End(xlToRight)

'Sheets("Sheet1").Range("C100").End(xlUp)(2) _
= rngPN.End(xlToLeft)

Next
End If
Next

End Sub