How to loop

[bouncey]

Hi there,

I have the following code but I need for it to keep going until the last cell that has data. I have no idea how to do this could anybody point me in the right direction?
(code)Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPict As Picture
Dim PictureLoc As String

If Target.Address = Range("A2").Address Then

ActiveSheet.Pictures.Delete

PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("A2").Value & ".png"

With Range("B2")
Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
.RowHeight = myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With

End If

End Sub (Code)

 

[bouncey]

a

 

[shg]

The last cell in what?

 

[bouncey]

The last cell in column A.

 

[Michael M]

This is just a wild guess at what you want ????

Sub MM1()
Dim myPict As Picture, PictureLoc As String
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Pictures.Delete
For r = 2 To lr
    PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("A" & r).Value & ".png"
    With Range("B" & r)
        Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
        .RowHeight = myPict.Height
        myPict.Top = .Top
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With
Next r
End Sub

 

[bouncey]

Thanks Michael this worked a treat. I don't suppose you know how I can control the height and width of the jpeg's?

 

[Michael M]

Maybe like this

Sub MM1()
Dim myPict As Picture, PictureLoc As String
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Pictures.Delete
For r = 2 To lr
    PictureLoc = "C:\\Users\Admin\Desktop\images" & Range("A" & r).Value & ".png"
    With Range("B" & r)
        Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)
        .RowHeight = myPict.Height
        myPict.Top = .Top
        myPict.Left = .Left
        myPict.Width = 150
        myPict.Height = 150
        'myPict.Placement = xlMoveAndSize
    End With
Next r
End Sub