Find PartNumbers

Option Explicit
Sub FindCodeCellAdrs()
' hiker95, 12/14/2013
' http://www.mrexcel.com/forum/excel-questions/745111-find-partnumbers.html
Dim c As Range, fr As Long
Application.ScreenUpdating = False
For Each c In Range("M3", Range("M" & Rows.Count).End(xlUp))
  fr = 0
  On Error Resume Next
  fr = Application.Match("*" & c & "*", Columns(1), 0)
  On Error GoTo 0
  If fr = 0 Then
    With Cells(c.Row, "O")
      .Value = "No"
      .HorizontalAlignment = xlCenter
    End With
  ElseIf fr > 0 Then
    With Cells(c.Row, "H")
      .Value = Cells(fr, "N")
      .HorizontalAlignment = xlCenter
    End With
    With Cells(c.Row, "I")
      .Value = "N" & fr
      .HorizontalAlignment = xlCenter
    End With
  End If
Next c
Application.ScreenUpdating = True
End Sub

Option Explicit
Sub FindCodeCellAdrsV2()
' hiker95, 12/15/2013
' http://www.mrexcel.com/forum/excel-questions/745111-find-partnumbers.html
Dim a As Variant, i As Long, ii As Long, n As Long, lr As Long
lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
a = Range("A1:O" & lr)
For i = 3 To UBound(a, 1)
  n = 0
  If a(i, 13) <> "" Then
    For ii = 3 To UBound(a, 1)
      If InStr(LCase(a(ii, 1)), LCase(a(i, 13))) Then
        n = n + 1
        a(ii, 8) = a(i, 14)
        a(ii, 9) = "N" & i
      End If
    Next ii
    If n = 0 Then a(i, 15) = "No"
  End If
Next i
Range("A1").Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub