pie2251 wrote:G'day Just Found This Handy Little Excel File Well Done.
Is There A Way To Modify The VBA To Collect
Back3 | Back2 | Back1 | SP | Lay1 |Lay2 |Lay3
Thanks In Advance :D
Little Stuck Now Done Most Of The Work.
I Have Modified Sub IntialINFO2 & RecOddsBeforeStart2
Font Colour "RED" Changes
Not Sure How To Get
Back3 | Back2 | Back1 | SP
| Lay1 |Lay2 |Lay3 Across For Every Horse, Only Last Horse Shows All.
Sub InitialINFO2() NoS = Sheets("Status " & MyVar).Range("D12")
If NoS = 0 Then Exit Sub
LRow = Sheets("Data " & MyVar).Range("G65536").End(xlUp).Row
'If LRow = 0 Then LRow = 1
'Sheets("Data " & MyVar).Range("G" & LRow + 1 & ":IV" & LRow + 2).NumberFormat = "@"
For x = 1 To NoS
Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 3) =
"B3" Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 4) =
"B2" Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 5) =
"B1" Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 6) =
"SP" Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 7) = "L1"
Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 8 ) = "L2"
Sheets("Data " & MyVar).Cells(LRow + 1, x * 4 + 9) = "L3" Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 3) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 4) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 5) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 6) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 7) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 8) = Sheets(MyVar).Range("A" & (x + 4))
Sheets("Data " & MyVar).Cells(LRow + 2, x * 4 + 9) = Sheets(MyVar).Range("A" & (x + 4)) Next x
Sheets("Data " & MyVar).Range("C" & LRow + 2) = "Date"
Sheets("Data " & MyVar).Range("D" & LRow + 2) = "Event"
Sheets("Data " & MyVar).Range("E" & LRow + 2) = "Time"
Sheets("Data " & MyVar).Range("F" & LRow + 2) = "Duration"
Sheets("Data " & MyVar).Range("C" & LRow + 3) = Sheets(MyVar).Range("B2")
Sheets("Data " & MyVar).Range("D" & LRow + 3) = Sheets(MyVar).Range("A1")
End SubSub RecOddsBeforeStart2() If Sheets("Status " & MyVar).Range("D22") = "" And Sheets("Status " & MyVar).Range("D31") = "NOT STARTED" Then
Call InitialINFO
Sheets("Status " & MyVar).Range("D22") = "RECORDING"
End If
' Using D31 (from macro)
If Sheets("Status " & MyVar).Range("D31") = "NOT STARTED" Then
LRow = Sheets("Data " & MyVar).Range("G65536").End(xlUp).Row + 1
' Copy time,duration
Sheets("Data " & MyVar).Range("E" & LRow) = Sheets("Status " & MyVar).Range("D14")
Sheets("Data " & MyVar).Range("F" & LRow) = Sheets("Status " & MyVar).Range("D40")
' Copy selection's data
NoS = Sheets("Status " & MyVar).Range("D12")
Dim array1 As Variant
For x = 1 To NoS
array1 = Array(Sheets(MyVar).Range(
"B" & x + 4), Sheets(MyVar).Range(
"D" & x + 4), Sheets(MyVar).Range(
"F" & x + 4), Sheets(MyVar).Range(
"Y" & x + 4),
Sheets(MyVar).Range("H" & x + 4), Sheets(MyVar).Range("J" & x + 4), Sheets(MyVar).Range("L" & x + 4)) Sheets("Data " & MyVar).Range(Sheets("Data " & MyVar).Cells(LRow, x * 4 + 3), Sheets("Data " & MyVar).Cells(LRow, x * 4 + 9)).Value = array1
Next x
End If
End SubMy VBA Knowledge Is Pretty Limited (Very Basic)