Could you check my code please

[ipbr21054]

In my worksheet i have a code where when i type a number in a cell in column A its matched photo of which i have named the same as the entered number is automatically placed into the same row but in column B
So A50 i type 123456 when i leave that cell automatically the photo 123456 is now shown in cell B50

My problem is that this has stopped at row 59 and will not enter the photo anymore.
I thought it was the number entered into the cell but as a test i entered the same number into cell A58 and the photo was shown no problem.
I try the same number in row A59 & no photo at all.

So im thinking maybe the code needs to be changed as maybe i previously set it to stop at 60 etc ???

The only code that i think relates to this above info is supplied below.

Can you confirm if its correct as im lost as to where / why the problem is.
Failing that how would i track down the issue.

Thanks

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

 

[JoeMo]

I haven't looked at all your code, but this line near the start of the code:

If Target.Row Mod 20 = 0 Then Exit Sub

will prevent the code from running if you enter a number into cells A20, A40, A60, ... and so on. Why do you want this?

 

[ipbr21054]

Hmmm not sure as it was advised by a member some months ago.

Tomorrow I will check to see if there are values in 20 40 60 as you say.

Failing that is it safe to just remove that line

 

[JoeMo]

Hmmm not sure as it was advised by a member some months ago.

Tomorrow I will check to see if there are values in 20 40 60 as you say.

Failing that is it safe to just remove that line

I can't see any reason for that line. Removing it is safe.

 

[ipbr21054]

Hi,
Looking at my worksheet cell 20 & 40 has info in it ?
Anyway before i deleted that line of code i tried the following

Line 79 all ok
Line 80 did not work

Line 99 all ok
Line 100 did not work

A deleted that line of code and now line 60 80 100 etc etc works as it should.

Thanks very much.

 

[JoeMo]

Hi,
Looking at my worksheet cell 20 & 40 has info in it ?
Anyway before i deleted that line of code i tried the following

Line 79 all ok
Line 80 did not work

Line 99 all ok
Line 100 did not work

A deleted that line of code and now line 60 80 100 etc etc works as it should.

Thanks very much.

You are welcome - thanks for the reply.