Could you check my code please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,128
Office Version
  1. 2007
Platform
  1. Windows
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

Code:
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,751
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I haven't looked at all your code, but this line near the start of the code:
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

Well-known Member
Joined
Nov 16, 2010
Messages
4,128
Office Version
  1. 2007
Platform
  1. Windows
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

MrExcel MVP
Joined
May 26, 2009
Messages
17,751
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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

Well-known Member
Joined
Nov 16, 2010
Messages
4,128
Office Version
  1. 2007
Platform
  1. Windows
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

MrExcel MVP
Joined
May 26, 2009
Messages
17,751
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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.
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,491
Messages
5,764,679
Members
425,229
Latest member
Rashid mahmood

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top