Managing pictures in excel

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

impala096

Your forum profile needs to show the Excel PRODUCT that you need this request to work with.

The best solutions often rely on knowing WHICH Office PRODUCT (Excel, NOT Windows) that you have. Please check that your forum profile is up-to-date. If you aren't sure, in Excel go to File/Account and report what it says below the MS logo at the top of that page. If your version is for Mac, please also state this.

The three most recent Excel PRODUCTS are Excel 2019, Excel 2021 and MS365 - if you are using MS365, please give this name along with the Version number in your profile (e.g. MS365 (PC) Version 2211). The version number is in the About Excel section further down the Account page.

Also please post an Excel workbook sample not a screen shot or pic. Please see instructions in the 'gold' banner at the top of the page.