by mikey » Mon Aug 31, 2009 10:34 pm
Hi,
I am trying to the following but either don't get anything happen at all or get run time errors :
1. find the next empty line on sheet 2
logRow = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
2. copy 4 cells onto another sheet
For nRunner = 1 To 40
theRow = nRunner + 4
If ws1.Range("AN" & theRow).Value <> 0 Then
ws2.Range("A" & logRow).Value = sRaceDets
ws2.Range("B" & logRow).Value = ws1.Range("AN" & theRow).Value
ws2.Range("C" & logRow).Value = ws1.Range("AL" & theRow).Value
ws2.Range("D" & logRow).Value = ws1.Range("AM" & theRow).Value
logRow = logRow + 1
End If
3. Run this code when the race is finished
The cells I copy are:
AN - Race winner ( rank no.1 calc)
AL - Odds bet was placed at
AM - Profit/Loss on winner
Most of this code is from a sheet someone gave to me a while back which copys and pastes the lay odds at the off it works fine but when i change the cells to copy my data it falls over, All data to copy is on the same sheet and the destination sheet is the same.
Am I calling this in the wrong place? I've tred everthing i can think of but i am stuck!
Not very good at this codeing thing!!! Can anyone help?
mike...
the code below is also doing a lot of other stuff as well.
Option Explicit
Dim sRaceDets As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
' ------------------------------------
' PROCESS ALL CHANGES TO THE WORKSHEET
' ------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReturn As Integer
' Only process whole updates
If Target.Columns.Count <> 16 Then Exit Sub
' Set-up workbook variables
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("AE_Meeting_1")
Set ws2 = wb1.Sheets("AE_Log")
' Initialise the bot on the first pass through
If ws1.Range("AE8").Value = "N" Then
Call InitialiseBot
End If
' Stop any further updates until we have completed
Application.EnableEvents = False
' See if we have started a new race
If ws1.Range("A1").Value <> sRaceDets Then
Call InitialiseNewRace
End If
' Check to see if an event has changed status
Call RecordEventStatus
' Enable events as all updates have been completed
Application.EnableEvents = True
End Sub
' --------------
' INITIALISATION
' --------------
Sub InitialiseBot()
sRaceDets = ""
ws1.Range("AE8").Value = "Y"
End Sub
' --------
' NEW RACE
' --------
Sub InitialiseNewRace()
sRaceDets = ws1.Range("A1").Value
' Reset timers
ws1.Range("AE6").Value = 0
ws1.Range("AE7").Value = 0
' Reset the flags
ws1.Range("AE10").Value = "N"
' Force the refresh value to 1.0
ws1.Range("Q2").Value = 1
' reset finnished flag
ws1.Range("AE11").Formula = "=AE12"
End Sub
' ------------------------------
' RECORD CHANGES IN EVENT STATUS
' ------------------------------
Sub RecordEventStatus()
' Check to see if an event has gone In Play
If ws1.Range("AE6").Value = 0 And ws1.Range("AB6").Value = "In Play" Then
' Copy the time that the event went In-Play
ws1.Range("AE6").Value = ws1.Range("AB5").Value
' Copy the lay odds to the log
Call LogLayOdds
Exit Sub
End If
' Check to see if an event has gone Never Went In Play
If ws1.Range("AB6").Value = "Never Went In Play" Then
If ws1.Range("AE7").Value = 0 Then
' Copy the time that the event went In-Play
ws1.Range("AE7").Value = ws1.Range("AB5").Value
Else
If ws1.Range("AE11").Value = "Y" Then
' Copy the lay odds to the log
Call LogLayOdds
ws1.Range("AE11").Value = "N"
Exit Sub
End If
End If
End If
' Check to see if a temporarysuspension has been lifted
' Never Went In Play reverts to Not In Play
If ws1.Range("AB6").Value = "Not In Play" And ws1.Range("AE7").Value > 0 Then
ws1.Range("AE7").Value = 0
End If
'Copy the lay odds to the holding area
If ws1.Range("AB6").Value = "Not In Play" Then
Call CopyLayOdds
End If
End Sub
' -------------------------
' COPY THE CURRENT LAY ODDS
' -------------------------
Sub CopyLayOdds()
Dim nRunner As Integer
Dim theRow As Integer
For nRunner = 1 To 40
theRow = nRunner + 4
ws1.Range("AG" & theRow).Value = ws1.Range("H" & theRow).Value
Next
End Sub
' -----------------------------------------
' COPY THE LAY ODDS (AT THE OFF) TO THE LOG
' -----------------------------------------
Sub LogLayOdds()
Dim logRow As Integer
Dim theRow As Integer
Dim nRunner As Integer
' Find out the row number for the next blank line in the log
logRow = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
' Copy the details to the log
For nRunner = 1 To 40
theRow = nRunner + 4
If ws1.Range("AN" & theRow).Value <> 0 Then
ws2.Range("A" & logRow).Value = sRaceDets
ws2.Range("B" & logRow).Value = ws1.Range("AN" & theRow).Value
ws2.Range("C" & logRow).Value = ws1.Range("AL" & theRow).Value
ws2.Range("D" & logRow).Value = ws1.Range("AM" & theRow).Value
logRow = logRow + 1
End If