Automatisk opdatering af pivottabeller hver 2. minut

Prøv med dette.

Sæt denne kode ind i selve projektmappens kodemodul (Denne_projektmappe i den danske udgave af Excel)

Private Sub Workbook_Open()
    PivotTimer
End Sub

Og sæt denne kode ind i et modul:

Sub PivotTimer()
  Dim pivotTable As pivotTable
  For Each pivotTable In ActiveSheet.PivotTables
    pivotTable.RefreshTable
  Next
  Application.OnTime Now + TimeValue("00:02:00"), "PivotTimer"
'Hvis den skal refreshes oftere, f.eks. hvert halve minut
'så ret TimeValue tiul ("00:00:30")
End Sub

Hej Natkatten

Tak for dit forslag. Jeg har fundet en høkermetode som virker upåklageligt. Jeg synes dog du skal smide et svar, da din løsning sikkert ligeledes vil fungere efter ønsket :)

Ok. Vurder om du vil tage points retur. I så fald opret selv et svar og afvis dette.

Hej msl_ddm.

Kan du beskrive din høker, for en nysgerrig? :)

Hej Laguna

Det kan du tro, det er egentligt en kombination af to tidligere anvendte kodestykker:

#1 En funktion (MODULE) der på timer, kopierer en anden celle og indsætter indholdet som værdi. Her har jeg i celle A2 en =NU() formel, som hvert 10. sekund kopieres og indsættes som værdi i A3.

Dim TimeToRun

Sub auto_open()
    Call ScheduleCopyPriceOver
End Sub

Sub ScheduleCopyPriceOver()
    TimeToRun = Now + TimeValue("00:00:10")
    Application.OnTime TimeToRun, "CopyPriceOver"
End Sub

Sub CopyPriceOver()
    Calculate
    Range("a3").Value = Range("a2").Value
    Call ScheduleCopyPriceOver
End Sub

Sub auto_close()
    On Error Resume Next
    Application.OnTime TimeToRun, "CopyPriceOver", , False
End Sub


#2 En funktion der opdaterer en række udvalgte pivottabeller, såfremt der sker ændring i værdierne i A1:A3. NU() formlen er indtastet i en stamdatakolonne i en tabel som er trukket fra en SQL forbindelse. Denne tabel opdaterer automatisk hvert minut (dette er en standardindstilling). Det vil sige at min NU() formel opdateres hvert minut. MEN, uden ovenstående funktion i #1, læser nedenstående funktion ikke ændringen i NU() funktionen, som en reelt ændring af værdierne i A1:A3, det gør den derimod når værdien kopieres ind og overskriver den eksisterende værdi i A3.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A1:A3")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
          Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
    ActiveSheet.PivotTables("SalgsperformanceDAG").PivotCache.Refresh
      ActiveSheet.PivotTables("SalgsperformanceUGE").PivotCache.Refresh
      ActiveSheet.PivotTables("SalgsperformanceUGEspec").PivotCache.Refresh
   
     
    End If
End Sub