Posts by hanley1992

I got rid of the many versions of this sheet and downloaded version 2.2 again which has the following...

MODULE 1

Sub check1()
    Dim lRow As Long
    
    Application.ScreenUpdating = 0
    With Sheets("Sheet1").Cells(1).CurrentRegion
        With .Offset(4).Resize(.Rows.Count - 4, 16)
            .Sort .Columns(1)
        End With
        x = .Value2
    End With
    With Sheets("race1")
        If .[a61] = vbNullString Then
            lRow = 61
        Else
            lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 15 - .[c20]
        End If
        .Cells(lRow, 1).Resize(UBound(x, 1), UBound(x, 2)) = x
        .Columns(1).AutoFit
        .Activate
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollRow = lRow
    End With
    
End Sub

The accompanying WORKSHEET 1 code

Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsError(Application.Match([c2], [Times], 0)) Then
        Application.EnableEvents = 0
        check1
        Application.EnableEvents = 1
        
    End If
End Sub

The old problem is persisting when sheet 1 is live with the live time changing in cell C2, The check1 code will execute on time according to the schedule in 'race1' sheet the value in A20 will turn from 0 to 1 butthen when reverting from 1 to 0 after the first paste it quickly pastes again and I am left with this problem of 2 pastes rather than 1.

If I disable the live feed into 'sheet1' and manually enter time values that will match the schedule times on 'race1' sheet the check 1 code will fire once and work perfectly every time with a single paste.

KJ, I can only assume that if you have got this same code to paste once the problem is with the feed when it is live and changing. When I manually enter a time in C2 and it works fine and pastes once the 1 value in cell A20 on race1 sheet remains.Is the problem perhaps that when live and the time moves on past the schedule time again aftyer firing the macro, the change in cell A20 from 1 back down to zero is firing check one for a 2nd time.

before trigger time A20 =0 when hits trigger time changes to 1 and fires check 1
after trigger time A20 reverts back to 0 from 1 and fires for the 2nd time

Amazing how something that seemed so simple is proving to be so awkward!

I appreciate you have spent plenty of time on this already, If you think of anything new I would be most grateful, I will also be trying to see if I can find a similar problem on the net that was overcome.

Many Thanks

The first block label didn't post for some reason * all the code from module 1

I was obviously very close to the solution KJ as you reached it. From the double posting problem, i have tried to follow all the changes on here and also update your sheet with Carim's changes (to thisworkbook code) but am now actually managing to get error messages in check 1.

Here is all the code I have in my book now, If you could have a look and see what is going wrong I would be most grateful.

Option Explicit
Dim NextTime As Double
Sub check1()
    Dim lRow As Long
    
    Application.ScreenUpdating = 0
    With Sheets("Sheet1").Cells(1).CurrentRegion
        With .Offset(4).Resize(.Rows.Count - 4, 16)
            .Sort .Columns(1)
        End With
        x = .Value2
    End With
    With Sheets("race1")
        If .[a61] = vbNullString Then
            lRow = 61
        Else
            lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 15 - .[c20]
        End If
        .Cells(lRow, 1).Resize(UBound(x, 1), UBound(x, 2)) = x
        .Columns(1).AutoFit
        .Activate
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollRow = lRow
    End With
    
End Sub
Sub formatrace()
'
' formatrace Macro
'


'
    Columns("E:E").Select
    Selection.Replace What:="(*)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("K:K").Select
    Selection.Copy
    Columns("E:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("C:I").Select
    ActiveWorkbook.Worksheets("tjo").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("tjo").Sort.SortFields.Add Key:=Range("C2:C1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("tjo").Sort.SortFields.Add Key:=Range("D2:D1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("tjo").Sort.SortFields.Add Key:=Range("E2:E1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("tjo").Sort
        .SetRange Range("C1:I1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub RecordData()
Dim Interval As Double, cel As Range, Capture As Range
Interval = 5 'Number of seconds between each recording of dataSet Capture = Worksheets("Sheet1").Range("A1:A5") 'Capture this column of data
With Worksheets("Sheet2") 'Record the data on this worksheet
    Set cel = .Range("A2") 'First timestamp goes here
    Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0): cel.Value = Now
    cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Application.Transpose(Capture.Value)
End With
NextTime = Now + Interval / 86400
Application.OnTime NextTime, "RecordData"
End Sub
 
Sub StopRecordingData()
On Error Resume Next
Application.OnTime NextTime, "RecordData", , False
On Error GoTo 0
End Sub

Sheet1

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    If Not IsError(Application.Match([c2], [Times], 0)) Then
        Application.EnableEvents = 0
        check1
        Application.EnableEvents = 1
    End If
End Sub

Sheet3(race1)

Option Explicit


Private Sub CommandButton1_Click()
    Worksheets("race1").Activate
    Range("d5:j5").ClearContents
    Range("d5").Activate
End Sub


Private Sub CommandButton2_Click()
    check1
End Sub

Sheet5(tjo)

Option Explicit


Private Sub CommandButton1_Click()
formatrace


End Sub


Private Sub CommandButton2_Click()
Worksheets("tjo").Activate
Range("c1:j1000").ClearContents
ThisWorkbook.Sheets("tjo").Range("l1").Select
End Sub

Thisworkbook

Option Explicit


'This code should go in a regular module sheet, and won't work properly if installed anywhere else. _
   The next (Dim) statement must occur before any subs or functions.

Can I please repost this book back to you because I have become totally and utterly lost with all the changes and folders and carim's version etc etc. I really have tried to follow but I'm not sure now what should be where, I'm so sorry.

I updated that code into sheet1, it's still pasting twice KJ.

It's waiting for the schedule times and guess what Kj, it's firing the macro twice again! like it did in the initial code (your code is obviously immeasurably better).

Is this stuff in 'thisworkbook' as Carim suggested earlier a potential problem?

I'm not even sure if it's doing anything, I have totally reworked this book from what it used to be. (it was a book initially coded by associates of the ApI but it was awful for my needs.

Yes that's correct sheet1 will be updating depending on the API setting which currently is set to 1 second.

And yes spot on i only want to fire up check1 when C2 matches any of the schedule times in those cells on race 1 (D1:L1).That would be exactly what's required.

I

Hi Kj, Thanks for all your efforts with this, that check1 code looks very slick indeed.

Unfortunately it isn't taking the schedule times into account in 'race1' (D1 to L1), as soon as the feed comes in no matter what time it is it fires up check 1 every second , the pasting is going in exactly the right places but the schedule times are in effect redundant.

Blimey delete row 11 even containing Poppy Jay

I need a break as I'm clearly a bit fatigued with this so will have a look back later.

Kind Regards.

If you got to sheet 1 and take one of the runners say 'Poppy Jay' by deleting A8

*deleting row 8 on sheet1 containing 'Poppy Jay'

If you click the Command Button on'race1' at C19 you will see the macro fires and a new paste will have appeared in cell A133. If you got to sheet 1 and take one of the runners say 'Poppy Jay' by deleting A8 and then go back to race1 and click the command button again The next paste will have been performed by check1 from cell a151 down. No matter how the number of runners get changed the data will always be pasted into blocks of 18 starting at A61 for each execution of check1.

So check1 definitely works using the command button but it just doesn't when tryiuse the schedule times via Sub Worksheet Calculate

Kj

re my initial code...

The check1 macro fires perfectly using the command button, each click will execute it once and it will be pasted in the desired location. The paste destination is worked depending on the number of runners in the copy location (sheet1)

pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(15 - i, 0).PasteSpecial xlPasteValues

where

i = Worksheets("race1").Range("c20").Value

The offset value needs to be calculated so that all of these locations are always fixed whatever the amount of runners in any given race, this is absolutely essential as the data in these paste locations are then fed into various parts of the sheet.once the race is over the next step will be to export s5:bz18 into a results book.

I have no experience of using sub worksheet calculate but the problem has to be with this rather than the check1 macro as this works fine when triggered by manual input or the command button.

My last post is based on the initial code posted not the changes made from Carim's proposal.

Thanks by the way Carim for the heads up about the API code being stored in the wrong place (this workbook).

Kj

I assume the code is firing twice as the copy and paste occurs twice and i get a paste in A61 and then another duplicate below A79.

If i either use the command button instead (method1) as posted earlier the macro will run once as desired so i know the macro check 1 is fine. Also if i disable the API live feed and manually enter into C2(sheet1) a time value that matches one of the schedule times this will also fire the check1 macro once as desired.

The problem I assume from all this must be with the sub work calculate routine whilst the feed is live and I can't see why it wants to execute check1 twice.

Carim,

Cell A21 in 'race1' is the live time as referenced in 'sheet1' C2 from the API live feed. Cell A20 is a formula that looks to see if this A21 time is matched anywhere in the love schedule on that sheet (Cells D1 to L1). If there is no match Cell A20=0, if a match then A20=1 and the macro should be triggered (sub worksheet calculate).

Obviously in a live feed the time will tick over the matched time on the next 2nd and this value will switch back to zero until another time match occurs. I appreciate you cannot see this but it's what happens.

My earlier code the time would tick on one of the schedule times, Cell A20 would go to 1 and the macro would trigger the copy and paste routine into cell A61 (check1). rather than ending there, a second later the macro would trigger again when Cell A20 had gone back to zero, obviously this shouldn't happen at this point or this is not the desired outcome anyhow!

Cell A20 is giving the correct value 1 when the times are matched up but it's just not then executing, whereas in the previous code it actually executed twice.

Carim, firstly my express apologies at mis spelling your name earlier!

Unfortunately this revision of code ...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$20" Then Exit Sub
  Application.EnableEvents = False
    If Target.Value > 0 Then Call check1
  Application.EnableEvents = True
End Sub

no longer executes the code at all.

I will try your proposal and get back to you shortly. Many thanks for your efforts.

Apologies Karim I was just replying to the post above yours when typing.

Private Sub Worksheet_Calculate()
    Application.EnableEvents = False
    If Range("a20").Value > 0 Then Call check1
    Application.EnableEvents = True
End Sub

Hi there and thanks for your reply. The above is the code which I thought was doing this?