Time Loop

[ahs_89]

Good Evening.

I need your help with a macro that has to do with time. I have tried to solve it own my own but is very difficult considering I am a beginner.

I am working with a temperature logger to control the temperature of a material in time.
This Interrogator shows me only live value in the same cell of excel updating on a defined time (like every 1 min).
I needed to store the variation to be able to see how the temperatures evolves in days.

My idea was to write a macro that copy every minute (or other defined time) this live cell and to paste it on another sheet one row after another and also coping the time on which that value was recorded.

The Interrogator is controlled by Macro. So I am pasting also the code of that because could by helpful.

Declare PtrSafe Function usb_tc08_set_channel Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal channel As Integer, ByVal tc_type As Byte) As Integer


Declare PtrSafe Function usb_tc08_run Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal interval_ms As Long) As Long


Declare PtrSafe Function usb_tc08_get_temp Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp_buffer As Single, ByRef times_ms_buffer As Long, ByVal buffer_length As Long, ByRef overflow, ByVal channel As Integer, units As Integer, ByVal fill_missing As Integer) As Long


Declare PtrSafe Function usb_tc08_get_temp_deskew Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp_buffer As Single, ByRef times_ms_buffer As Long, ByVal buffer_length As Long, ByRef overflow, ByVal channel As Integer, ByVal units As Integer, ByVal fill_missing As Integer) As Long
Declare PtrSafe Function usb_tc08_get_single Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Single, ByRef overflow_flags, ByVal units As Integer) As Long


'==========================================================================
'    Shared API Calls


'    These functions are designed for use with the USB TC08,
'    however, they can (and should) still be used with the legacy API calls
'===========================================================================*/


Declare PtrSafe Function usb_tc08_open_unit Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" () As Integer


Declare PtrSafe Function usb_tc08_close_unit Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_stop Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_set_mains Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal sixty_hertz As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_minimum_interval_ms Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Long


Declare PtrSafe Function usb_tc08_get_formatted_info Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal unit_info As String, ByVal string_length As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_unit_info2 Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal unit_info As String, ByVal string_length As Integer, ByVal line As Integer) As Integer


Declare PtrSafe Function usb_tc08_get_last_error Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer




'====================================================================
'    Legacy API Calls


'    Provided to aid backwards compatibility with code written
'    for old TC08 Units (differences exist).


'    These functions should not be used in new code and are
'    deprecated for removal in a future version of the driver.
'=====================================================================


Declare PtrSafe Function usb_tc08_legacy_run Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_set_channel Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByVal channel As Integer, ByVal tc_type As Integer, ByVal filter_factor As Integer, ByVal offset As Integer, ByVal slope As Integer)


Declare PtrSafe Function usb_tc08_legacy_get_temp Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Long, ByVal channel As Integer, ByVal filtered As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_get_cold_junction Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef temp As Long) As Integer
 
Declare PtrSafe Function usb_tc08_legacy_get_driver_version Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" () As Integer


Declare PtrSafe Function usb_tc08_legacy_get_version Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByVal handle As Integer, ByRef version As Integer) As Integer


Declare PtrSafe Function usb_tc08_legacy_get_cycle Lib "C:\Program Files\Pico Technology\SDK\lib\usbtc08.dll" (ByRef cycle As Long, ByVal handle As Integer) As Integer












Dim tc08_handle As Integer
Dim in_timer As Integer
Dim info As String * 80


Sub Close_Click()
  If (tc08_handle > 0) Then
    usb_tc08_close_unit (tc08_handle)
    tc08_handle = -1
    Cells(14, "E").value = "TC-08 closed"
  End If
End Sub




Sub Open_Click()
  Dim ok As Integer
  
  
  If (tc08_handle < 1) Then
    Cells(14, "E").value = "Opening TC-08"
    tc08_handle = usb_tc08_open_unit()
    If (tc08_handle > 0) Then
      Cells(14, "E").value = "TC-08 opened"
      
      
      Cells(9, "A").value = "Driver Version"
      Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 0)
      Cells(9, "B").value = info
      
      Cells(10, "A").value = "Kernel Driver Version"
      Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 1)
      Cells(10, "B").value = info
            
      Cells(11, "A").value = "Serial Number"
      Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 4)
      Cells(11, "B").value = info
      
      Cells(12, "A").value = "Cal Date"
      Call usb_tc08_get_unit_info2(tc08_handle, info, 80, 5)
      Cells(12, "B").value = info
      
      Call usb_tc08_set_mains(tc08_handle, True)
      ok = usb_tc08_set_channel(tc08_handle, 0, Asc("T"))
      ok = usb_tc08_set_channel(tc08_handle, 1, Asc("T"))
      ok = usb_tc08_set_channel(tc08_handle, 2, Asc("T"))
      ok = usb_tc08_set_channel(tc08_handle, 3, Asc("T"))
      Call Timer1_Timer
    Else
      If (tc08_handle = 0) Then
        Cells(14, "E").value = "Unable to open TC-08"
      Else
        Cells(14, "E").value = "Error Code: " & usb_tc08_get_last_error(0)
      End If
    End If
  End If
  
  
  
End Sub




Private Sub Timer1_Timer()
  ReDim temp_buffer(9) As Single
  Dim overflow_flag As Integer


  If (tc08_handle > 0) Then
    If (Not in_timer) Then
      in_timer = True
      
      ok = usb_tc08_get_single(tc08_handle, temp_buffer(0), overflow_flag, 0)
      
      If (ok) Then
       Cells(4, "A").value = temp_buffer(0)
       Cells(4, "B").value = temp_buffer(1)
       Cells(4, "C").value = temp_buffer(2)
       Cells(4, "D").value = temp_buffer(3)
      End If
      in_timer = False
    End If
  End If
  If tc08_handle > 0 Then Application.OnTime Now + TimeValue("00:00:05"), "Timer1_Timer"
  
End Sub

Here is also a screenshot of the spreadsheet.

Immagine.jpg

Thanks for any help I will receive

[mdmackillop]

Two ways to try

Timed loop

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:01"), "Record_Time"
End Sub

Sub Record_Time()
Dim tgt As Range
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(1).Cells(1, 1).Copy tgt
tgt.Offset(, 1) = Now()
Application.OnTime Now + TimeValue("00:00:01"), "Record_Time"
End Sub

Change event

Private Sub Worksheet_Change(ByVal Target As Range)
Record_Time_2
End Sub

Sub Record_Time_2()
Dim tgt As Range
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(1).Cells(1, 1).Copy tgt
tgt.Offset(, 1) = Now()
End Sub

[mdmackillop]

Third option; modify your existing code

If (ok) Then
                'Cells(4, "A").Value = temp_buffer(0)
                'Cells(4, "B").Value = temp_buffer(1)
                'Cells(4, "C").Value = temp_buffer(2)
                'Cells(4, "D").Value = temp_buffer(3)
                
                Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
                For i = 0 To 3
                    tgt.Offset(, i) = temp_buffer(i)
                Next i
                tgt.Offset(, 4) = Now()
                
            End If

[ahs_89]

Thank you mdmackkillop.

I used the third solution you proposed. In fact I used the same code before but I didn't now how to paste to a next row every time. It was the Row.count that I was missing.

Thank you another time