Optimize code

[TorrO]

Hi

I present my pulse in a graph like this:

To present graph per exercise I use a macro that deletes the graph, copies new data and past data into graph. ( I did not manage to solve it in other ways.)
The macro the goes back and forth to the raw data copy date, max puulse and info text.

I have navigation (next + previous)

I have recorded and configured the macro. The macro runs slow.... any way to optimize?

What this macro does is in simple terms
1 choose the graph line
2 delete graph
3 paste new values

Here is my code next dataset:

Sub venstre()
'
'

'
    Application.ScreenUpdating = False
    Sheets("Presentasjon").Select
    ActiveSheet.Range("A1").Select
    Sheets("GrafData").Select
    ActiveCell.Offset(3, -1).Range("A1").Select ' flytter 2 ned 1 til venstre
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy 'pulse
    Sheets("Presentasjon").Select
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveChart.FullSeriesCollection(1).Select
    Selection.Delete
    ActiveChart.Paste
    Sheets("GrafData").Select
    Selection.End(xlUp).Select
    Selection.Copy 'copy max
    Sheets("Presentasjon").Select
    ActiveSheet.Range("A1").Select
    ActiveCell.Offset(1, 19).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("GrafData").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.Copy 'date
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Sheets("Presentasjon").Select
    ActiveCell.Offset(0, -9).Range("A1").Select
    ActiveSheet.Paste
    Sheets("GrafData").Select
    ActiveCell.Offset(2, 0).Range("A1").Select
    Selection.Copy 'copy info
     Sheets("Presentasjon").Select
      ActiveCell.Offset(0, 3).Range("A1").Select
      ActiveSheet.Paste
   
End Sub

 

[DanteAmor]

You have these lines.

    Sheets("GrafData").Select
    ActiveCell.Offset(3, -1).Range("A1").Select ' flytter 2 ned 1 til venstre

But after selecting the sheet "GrafData" I don't know which cell the cursor is in, then you move it 3 cells down and one to the left.

Assuming that cell is "C1", I'll give you the code, just change "C1" to the cell where it starts. In this line of the macro:

Set rng = sh2.Range("C1").Offset(3, -1)

Since I don't know what the starting cell is, I also don't know what cells you're copying in these lines:

    Sheets("GrafData").Select
    Selection.End(xlUp).Select
    Selection.Copy 'copy max

Assuming, again, that the starting cell is C1, then you would be copying cells B1, B2, and B3. If they are other cells, update the cells in the macro:

Sub venstre_v2()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range
  Dim ChObj As ChartObject
  
  Set sh1 = Sheets("Presentasjon")
  Set sh2 = Sheets("GrafData")
  Set ChObj = sh1.ChartObjects("Chart 3")
  Set rng = sh2.Range("C1").Offset(3, -1)
  sh2.Range(rng, rng.End(xlDown)).Copy
  
  ChObj.Chart.FullSeriesCollection(1).Delete
  ChObj.Chart.Paste
    
  sh1.Range("T2").Value = sh2.Range("B1").Value
  sh1.Range("N2").Value = sh2.Range("B2").Value
  sh1.Range("K2").Value = sh2.Range("B3").Value
End Sub

If you have difficulty adapting the code, then share your file on google drive.
You could upload a copy of your file to a free site such google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.