Run time error 1004, Application defined or object defined error

[ipbr21054]

Morning,

The 2 codes in use are supplied below.

I run the duplicate checker & i am told that a duplicate has been found & cell reference mentioned.
I then click OK on the msgbox & delete the duplicate.
I then see a run time error 1004, Appllication defined or object defined error.

This line is shown in yellow when i debug, If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then

Private Sub Worksheet_Change(ByVal Target As Range)    Dim shp                   As Shape
    Dim picPath               As String
    Dim vFile


    picPath = "C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\"


    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row Mod 20 = 0 Then Exit Sub
    On Error GoTo son


    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then
            shp.Delete
        End If
    Next


    If Target.Value <> "" Then
        ChDrive picPath
        ChDir picPath
        picPath = picPath & Target.Value & ".jpg"
        If Dir(picPath) = "" Then    'picture not there!
            If MsgBox("Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then
                ' prompt to select the picture file
                vFile = Application.GetOpenFilename(filefilter:="JPEG image files (*.jpg), *.jpg", Title:="Select image file")
                ' exit if they cancelled
                If vFile = False Then
                    Exit Sub
                Else
                    picPath = vFile
                End If
            Else
                Exit Sub
            End If
        End If
    With Target.Offset(0, 1)
        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picPath, _
                                                linktofile:=msoFalse, savewithdocument:=msoTrue, _
                                                Left:=.Left + 5, Top:=.Top + 5, Width:=-1, Height:=-1)    ' -1 means use default size
        shp.LockAspectRatio = msoFalse
        shp.Height = .Height - 10
        shp.Width = .Width - 10
    End With
    End If
son:


End Sub

Private Sub CommandButton2_Click()    Dim cell As Range




    With Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange)
        For Each cell In .Cells
            If WorksheetFunction.CountIf(.Resize(cell.Row - .Rows(1).Row + 1), cell.Value) > 1 Then
             MsgBox "Duplicate Item Number " & cell.Value & "  in cell " & cell.Address(False, False) & vbLf & "Please correct and run this again.", vbCritical, "DUPLICATE ITEM NUMBER CHECKER"
             cell.Select
             Exit Sub
           End If
            
        Next cell


    End With
    MsgBox "No Duplicate Items Were Present", , "DUPLICATE ITEM NUMBER CHECKER"


End Sub

 

[ipbr21054]

I found the code whilst looking on the internet and it gave me what i needed,i will continue from here and use it.

Many thanks for ironing out some issue with it