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

 

[Joe4]

Just a shot in the dark here, but since msoPicture is not a variable, I believe it needs double-quotes around it, i.e.

[COLOR=#333333]If shp.Type = "msoPicture" And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then[/COLOR]

 

[dmt32]

Just a shot in the dark here, but since msoPicture is not a variable, I believe it needs double-quotes around it, i.e.

[COLOR=#333333]If shp.Type = "msoPicture" And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then[/COLOR]

Joe4

Think msoPicture is a constant from MsoShapeType Enumeration and has value of 13.

Dave.

 

[Joe4]

Think you will find msoPicture is a constant from MsoShapeType Enumeration and has value of 13.

If that is true, then perhaps it should be:

[COLOR=#333333]If shp.Type = 13 And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then[/COLOR]

 

[ipbr21054]

Hi,
With the code in post #2 i get a miss match error.

With the code in post # 4 i get the same error as per title of this post

 

[Joe4]

How did you come up with that line of code?

Since it has an "AND" statement, maybe try removing the second part temporarily, just to see if you can isolate what is causing the error.
If that works, then do the opposite, and drop the first part and keep the second.
One should give you the error. Then you know exactly what part if problematic and can focus on that.

 

[ipbr21054]

OK,
So this is what i have done.

With the code like this If shp.Type = msoPicture Then
If i enter a part number into cell A then all the other photos are deleted,if i then enter another part number in the next cell A below the photo above is deleted,thus only showing 1 photo.

With the code like this If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then
If i delete the row in question i then get the error message as per title.
BUT
I have noticed that if i just delete the part number then its photo is automatically deleted also.
This then works and no error message is shown.

So to make this as smooth as possible is there a way not to be able to delete the row so my users will then delete the cell part number.

Or what can you advise please.

Thanks

 

[Joe4]

Ah, I think i see the issue. Depending on how they are written, Worksheet_Change macros often "choke" on row deletions, as row deletions trigger the code to run.
There are a few things you can do.

When a row is deleted, ALL the cells in the row are deleted, so Excel sees it as a change to many cells, instead of just one cell. So you can put a line at the beginning of your code to tell Excel to exit the code and not run anything multiple cells are updated at the same time (like a whole row being deleted).
That line would look like this:

If Target.CountLarge > 1 Then Exit Sub

The other thing to consider is that if your code itself makes any changes to cells (including deleting rows), that itself, will trigger the code to run again. As such, if you do not want that to happen, you can temporarily disable events while the changes are being made, so that the code does not call itself again.
You would do that by placing this line of code before the changes:

Application.EnableEvents = False

You just need to remember to re-enable events after making the change (or else the automatic trigger will stop working, and you will wonder why your code isn't running!).
You do that by placing this line of code after the changes to any cells in the code are complete:

Application.EnableEvents = True

 

[ipbr21054]

Thanks,

I have applied only this code at present.

[COLOR=#333333]If Target.CountLarge > 1 Then Exit Sub[/COLOR]

What i have noticed though is when the row is deleted,now no error message is shown which is nice BUT the photo is still in cell B as a layer.
Before when i clicked the part number in cell A & then hit delete the part number & photo was deleted.

 

[Joe4]

Yes, that is correct, because as I mentioned in the previous post, adding that line will exit the code without running anything when a row is deleted.

I don't think that line of code is doing what you think it, especially this part:

[COLOR=#333333]shp.TopLeftCell.Address = Target.Offset(0, 1).Address[/COLOR]

When you delete a whole row, the target it the whole row, not a single cell.

You can see that if you test this out on another page and delete any row.

Private Sub Worksheet_Change(ByVal Target As Range)
    MsgBox Target.Offset(1, 0).Address
End Sub

Where exactly did you come up with that code?