How to make displayed image change after hitting button again in excel - excel

Question

My problem is when I press the command button it show the image but when I press it again the command button duplicates the image being displayed.
Private Sub CommandButton1_Click()
Dim pictureNameColumn As String 'column where picture name is found
Dim picturePasteColumn As String 'column where picture is to be pasted
Dim pictureName As String 'picture name
Dim lastPictureRow As Long 'last row in use where picture names are
Dim pictureRow As Long 'current picture row to be processed
Dim pathForPicture As String 'path of pictures
pictureNameColumn = "A"
picturePasteColumn = "E"
pictureRow = 2 'starts from this row
'error handler
On Error GoTo Err_Handler
'find row of the last cell in use in the column where picture names are
lastPictureRow = Cells(Rows.Count, pictureNameColumn).End(xlUp).Row
'stop screen updates while macro is running
Application.ScreenUpdating = False
pathForPicture = "C:\Users\drawing\Desktop\pic\"
'loop till last row
Do While (pictureRow <= lastPictureRow)
pictureName = Cells(pictureRow, "A") 'This is the picture name
'if picture name is not blank then
If (pictureName <> vbNullString) Then
'check if pic is present
'Start If block with .JPG
If (Dir(pathForPicture & pictureName & ".jpg") <> vbNullString) Then
Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".jpg").Select 'Path to where pictures are stored
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left
.Top = Cells(pictureRow, picturePasteColumn).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With
'End If block with .JPG
'Start ElseIf block with .PNG
ElseIf (Dir(pathForPicture & pictureName & ".png") <> vbNullString) Then
Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".png").Select 'Path to where pictures are stored
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left
.Top = Cells(pictureRow, picturePasteColumn).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With
'End ElseIf block with .PNG
'Start ElseIf block with .BMP
ElseIf (Dir(pathForPicture & pictureName & ".bmp") <> vbNullString) Then
Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".bmp").Select 'Path to where pictures are stored
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left
.Top = Cells(pictureRow, picturePasteColumn).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With
'End ElseIf block with .BMP
Else
'picture name was there, but no such picture
Cells(pictureRow, picturePasteColumn) = "No Picture Found"
End If
Else
'picture name cell was blank
End If
'increment row count
pictureRow = pictureRow + 1
Loop
Exit_Sub:
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub
Err_Handler:
MsgBox "Error encountered. " & Err.Description, vbCritical, "Error"
GoTo Exit_Sub
End Sub
What I want is when I press the button again the previous image will just be replaced by the new image base on the column A.

Answer 1

You need to locate the existing picture based on its position, then delete it, before inserting the next picture.
Loop over all the pictures in the sheet and check their position - when you find one which matches where you want to insert the new picture, delete it.
Sub tester()
DeletePicFromCell Range("I3")
End Sub
Sub DeletePicFromCell(c As Range)
Const MARGIN As Long = 10 '<< how far the picture can be out of place
Dim shp
For Each shp In c.Parent.Shapes
If Abs(shp.Left - c.Left) < MARGIN And _
Abs(shp.Top - c.Top) < MARGIN Then
shp.Delete
Exit For '<< done checking
End If
Next shp
End Sub
BTW you don't need all those blocks checking for different extensions: assuming all the potential matches are images you can do something like
Dim fName
fName = Dir(pathForPicture & pictureName & ".*") '<< match any extension
If Len(fName)>0 Then
'Have a match
'Insert image from pathForPicture & fName
End If
EDIT: your original code reworked
Private Sub CommandButton1_Click()
Const COL_PIC_NAME As Long = 1 'column where picture name is found
Const COL_PIC_PASTE As Long = 5 'column where picture is to be pasted
Const PIC_PATH As String = "C:\Users\drawing\Desktop\pic\"
Dim pictureName As String 'picture name
Dim pictureFile As String 'picture file
Dim pictureRow As Long 'current picture row to be processed
Dim sht As Worksheet
Dim picCell As Range
Set sht = ActiveSheet
For pictureRow = 2 To sht.Cells(sht.Rows.Count, COL_PIC_NAME).End(xlUp).Row
pictureName = sht.Cells(pictureRow, COL_PIC_NAME) 'This is the picture name
If Len(pictureName) > 0 Then
pictureFile = Dir(PIC_PATH & pictureName & ".*", vbNormal) 'is there a matching file?
If Len(pictureFile) > 0 Then
Set picCell = sht.Cells(pictureRow, COL_PIC_PASTE)
DeletePicFromCell picCell 'delete any previous picture
With sht.Pictures.Insert(PIC_PATH & pictureFile)
.Left = picCell.Left
.Top = picCell.Top
.ShapeRange.LockAspectRatio = msoFalse
.Height = 100
.Width = 130
End With
End If 'have picture
End If 'have picname
Next pictureRow
End Sub