Log File Timer Overload

[JordanCooper]

So I have this code:

and it works well but it logs on sheet 2 everytime the value is wrote in B14:J14. In other words, on sheet 1, all 9 values are copied into sheet 2 along with the date and time, anytime one of the 9 values changes. My other code updates these values continuously and everytime it updates them it logs it on sheet 2. sheet 2 fills up in like 15 minutes (all 65000 lines).

Is there any way to execute this code once or twice a min? or change it so it only logs it when the value genuinely changes (not just updates the cell).

thanks,

Jordan



Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range
Dim LastRow As Integer
Set VRange = Range("B14:J14")


Dim NewData As Range
Dim DataPage As Range
On Error Resume Next


Application.ScreenUpdating = False
LastRow = Sheets("Sheet2").Range("A65536").End(xlUp).Row


Set NewData = Sheets("Sheet2").Range("A" & LastRow + 1)


Set DataPage = Sheets("Sheet1").Range("B14")




If Union(Target, VRange).Address = VRange.Address Then
NewData.Value = Now()
NewData.Offset(0, 1).Value = DataPage.Value
NewData.Offset(0, 2).Value = DataPage.Offset(0, 1).Value
NewData.Offset(0, 3).Value = DataPage.Offset(0, 2).Value
NewData.Offset(0, 4).Value = DataPage.Offset(0, 3).Value
NewData.Offset(0, 5).Value = DataPage.Offset(0, 4).Value
NewData.Offset(0, 6).Value = DataPage.Offset(0, 5).Value
NewData.Offset(0, 7).Value = DataPage.Offset(0, 6).Value
NewData.Offset(0, 8).Value = DataPage.Offset(0, 7).Value
NewData.Offset(0, 9).Value = DataPage.Offset(0, 8).Value


End If


Application.ScreenUpdating = True
End Sub

 

[Yongle]

Try this

1 I have simplified your code and speeded it up - compare the BLUE lines with your code
2 Test this code without the RED lines first - check it still works (I have NOT tested it)
3 Add in the RED lines and test it again (I have not tested it)
- it should be comparing the concatenation of the current values in "B14:J14" with the concatenation of the previous values in sheet2

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim VRange As Range, LastRow As Integer
    Set VRange = Range("B14:J14")
    Dim NewData As Range, DataPage As Range

    On Error Resume Next

    Application.ScreenUpdating = False
    LastRow = Sheets("Sheet2").Range("A65536").End(xlUp).Row
    Set NewData = Sheets("Sheet2").Range("A" & LastRow + 1)
   
    If Union(Target, VRange).Address = VRange.Address Then
[COLOR=#ff0000]        With WorksheetFunction
            If .TextJoin(",", False, VRange) = .TextJoin(",", False, NewData.Offset(-1, 1).Resize(, 9)) Then GoTo TheEnd
        End With[/COLOR]
    
[COLOR=#0000cd]        With NewData
            .Value = Now()
            .Offset(0, 1).Resize(, 9).Value = VRange.Value
        End With[/COLOR]
    End If
TheEnd:
    Application.ScreenUpdating = True
End Sub

 

[JordanCooper]

Try this

1 I have simplified your code and speeded it up - compare the BLUE lines with your code
2 Test this code without the RED lines first - check it still works (I have NOT tested it)
3 Add in the RED lines and test it again (I have not tested it)
- it should be comparing the concatenation of the current values in "B14:J14" with the concatenation of the previous values in sheet2

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim VRange As Range, LastRow As Integer
    Set VRange = Range("B14:J14")
    Dim NewData As Range, DataPage As Range

    On Error Resume Next

    Application.ScreenUpdating = False
    LastRow = Sheets("Sheet2").Range("A65536").End(xlUp).Row
    Set NewData = Sheets("Sheet2").Range("A" & LastRow + 1)
   
    If Union(Target, VRange).Address = VRange.Address Then
[COLOR=#ff0000]        With WorksheetFunction
            If .TextJoin(",", False, VRange) = .TextJoin(",", False, NewData.Offset(-1, 1).Resize(, 9)) Then GoTo TheEnd
        End With[/COLOR]
    
[COLOR=#0000cd]        With NewData
            .Value = Now()
            .Offset(0, 1).Resize(, 9).Value = VRange.Value
        End With[/COLOR]
    End If
TheEnd:
    Application.ScreenUpdating = True
End Sub

It works the same with the red lines ommited. it does not log any data with the red lines in the code. Thanks again for you help.

 

[Logit]

.
Using the timer macro "RunMeOneMinute", it will fire once per minute, running your macro, then return and wait another minute before repeating.

You can use a CommandButton to activate the "RunMeOneMinute" macro ... or place a call to the macro in the ThisWorkbook module
Workbook_Open event.

Option Explicit


Sub RunMeOneMinute()
    
    Application.OnTime Now + TimeValue("00:01:00"), "UpdateSheet2" '<--- chane time delay value here.
End Sub




Private Sub UpdateSheet2()
Dim VRange As Range
Dim LastRow As Integer
Set VRange = Range("B14:J14")




Dim NewData As Range
Dim DataPage As Range
On Error Resume Next




Application.ScreenUpdating = False
LastRow = Sheets("Sheet2").Range("A65536").End(xlUp).Row




Set NewData = Sheets("Sheet2").Range("A" & LastRow + 1)




Set DataPage = Sheets("Sheet1").Range("B14")








If Union(Target, VRange).Address = VRange.Address Then
NewData.Value = Now()
NewData.Offset(0, 1).Value = DataPage.Value
NewData.Offset(0, 2).Value = DataPage.Offset(0, 1).Value
NewData.Offset(0, 3).Value = DataPage.Offset(0, 2).Value
NewData.Offset(0, 4).Value = DataPage.Offset(0, 3).Value
NewData.Offset(0, 5).Value = DataPage.Offset(0, 4).Value
NewData.Offset(0, 6).Value = DataPage.Offset(0, 5).Value
NewData.Offset(0, 7).Value = DataPage.Offset(0, 6).Value
NewData.Offset(0, 8).Value = DataPage.Offset(0, 7).Value
NewData.Offset(0, 9).Value = DataPage.Offset(0, 8).Value




End If


Application.ScreenUpdating = True


RunMeOneMinute
End Sub

 

[Yongle]

I it does not log any data with the red lines in the code

That is very strange
- the code is your code written slightly differently which is why "it works the same with the red lines ommited"
- so the code is being triggered by whatever your event is

With the red lines included, VBA tests the concatenation of B14:J14 against what was laid down the last time it changed.
The code does nothing if the values in B14:J14 are unchanged but records every change when any of those values change
I tested the code it and it works. I put the code behind sheet1 and it seems to do exactly what you want at this end.

What are you doing differently?
What causes the values in B14:J14 to change?
How often do they change?