Managing pictures in excel

[impala096]

I setup a spreadsheet to track the biggest intraday gainers in the stock market. A screenshot of the biggest intraday gainers are stored in Column B but the chart is only displayed when a cell in Column B is selected. For instance in the first picture Cell C2 is selected so no picture is displayed but in the next picture B2 is selected so the chart for GNPX is displayed. I attached the code I used to get this desired functionality. I am very quickly able to switch between reviewing the intraday data and looking at the intraday chart.

The problem is after 500 rows of data (and corresponding intraday charts) the spreadsheet is becoming sluggish when opening and saving. Is there a better way to manage all the pictures in the spreadsheet to keep it running snappy?

Untitled3.png

Untitled4.png

Sub addpictest()

  Dim pic_file As String
  Dim pict_name As String
  Dim pict1 As Picture
 
  If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
  pic_file = Application.GetOpenFilename("PNG (*.PNG), *.PNG", Title:="Pls open a picture file:")

  Set pict1 = ActiveSheet.Pictures.Insert(pic_file)
  pict_name = pict1.Name
 
 
  On Error Resume Next
 
  With ActiveCell.Comment.Shape
   .Fill.Visible = msoTrue
   .Fill.ForeColor.RGB = RGB(255, 255, 255)
   .Fill.BackColor.SchemeColor = 80
   .Fill.UserPicture (pic_file)
   .Height = 725
   .Width = 1921
   
Dim xComment As Comment

For Each xComment In ActiveSheet.Comments
   xComment.Shape.Placement = xlMove
Next

  End With
    
  pict1.Delete
  Set pict1 = Nothing
  ActiveCell.Comment.Visible = False
 
 
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 'www.contextures.com/xlcomments03.html
 Dim rng As Range
 Dim cTop As Long
 Dim cWidth As Long
 Dim cmt As Comment
 Dim sh As Shape
Application.DisplayCommentIndicator _
      = xlCommentIndicatorOnly
Set rng = ActiveWindow.VisibleRange
cTop = rng.Top + rng.Height / 2
cWidth = rng.Left + rng.Width / 2
If ActiveCell.Comment Is Nothing Then
  'do nothing
Else
   Set cmt = ActiveCell.Comment
   Set sh = cmt.Shape
   sh.Top = cTop - sh.Height / 2
   sh.Left = cWidth - sh.Width / 2
   cmt.Visible = True
End If
End Sub