Another Atempt

[Saxman]

Set below is the full coding which I have now cleaned up and works
satisfactorily except for Module4 (My Macro). The workbook gathers data
from the web at a time interval set by the user (usually 30-60 seconds).

There are three worksheets:-
"Console" whereby one connects/disconnects via command buttons and where
relevant information is displayed.

"Latest Snapshot" where the collected data is displayed.

"Chartdata" which is blank.

I need to copy the data from "Latest Snapshot" (Range J3:J17) and display
it in "Chartdata" (Range B2:B16) from which I can derive a chart. I have
created a macro in Module4 below for copying/pasting the data into
"Chartdata". Although it is a bit long winded, it works. I require the
copied data to work in unison with the main macro. As you can see it
copies the data every 30 seconds In the line (from Module4):-
'Application.Wait (Now + TimeValue("0:00:30"))'
It does this 15 times and stops for my purposes.

What I require is for my macro (Module4) to run within the main macro, so
that the data is gathered, pasted in "Latest Snapshot", then copied and
pasted into "Chartdata". However, the copied data when pasted into
"Chartdata" needs to move along one column (C2:C16) with every copy/paste
(as can be seen in Module4) for graphic purposes, so Rises and falls in
data can be viewed.

Apologies for previous postings about this, but it's becoming a bit cleare
to me.

I have just ordered the book "Excel VBA Macro Programming" by Richard
Shepherd, as I'm so enthused!

Thanks.
------------------------------------------------------------------------------
Module1................................................
Option Explicit
Sub GetExchangeShow()
'Extract and store Betfair price shows.

Dim sURL, sHTML As String
Const sBFMarketPrefix As String =
"http://www.betfair.com/betting/LoadMarketDataAction.do?mi="

'Mask screen redraws during automated operations.
Application.ScreenUpdating = False


'Construct the full Betfair market page name from the fixed and
variable parts.
sURL = sBFMarketPrefix &
ThisWorkbook.Worksheets("Console").Range("MarketID").Cells(1, 1).Value

'Extract the show text.
sHTML = GetExchangeData(sURL)

'Parse the betting fields from the HTML text ...
' ... and write the show into the Snapshot worksheet.
CreateShow (sHTML)
End Sub

Sub CreateShow(sHTML)
'Extracts the event name, names of selections(<=100), back/lay prices and
amounts available ...
' ... returning the results to the Snapshot worksheet via named ranges.
'We cannot continue to use the Webrowser Control because the data is held
in VBscript calls.
'No problem though since the arguments are effectively quote or
comma-delimited data.

Dim sQuote, sAmount As String
Dim StartField, EndField As Integer
Dim SelectionNo, QuoteNo As Integer
Dim sEName, sSels(1 To 100, 1 To 1) As String
Dim sBacks(1 To 100, 1 To 3), sLays(1 To 100, 1 To 3) As String

'If something goes wrong proceed directly to copy any data gathered
back to the worksheet.
On Error GoTo Cb

'Extract the name of the event: the text in single quotes after the
p.m_M declaration.
StartField = InStr(sHTML, "p.m_M")
StartField = InStr(StartField + 1, sHTML, "'") + 1
EndField = InStr(StartField + 1, sHTML, "'") - 1
sEName = Mid(sHTML, StartField, EndField - StartField + 1)

'Extract the names of up to 100 selections, the best three back and lay
prices ...
' ... and the amount of money currently available at those prices.
SelectionNo = 1
StartField = InStr(EndField, sHTML, "p.m_R")
While StartField <> 0 And SelectionNo < 101

'First the selection name between single quotes again ...
StartField = InStr(StartField + 1, sHTML, "'") + 1
EndField = InStr(StartField + 1, sHTML, "'") - 1
sSels(SelectionNo, 1) = Mid(sHTML, StartField, EndField -
StartField + 1)

'... then the 3 back and 3 lay prices, comma delimited, skipping 2
unwanted fields ...
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
For QuoteNo = 1 To 3
'Back price ...
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
sQuote = Mid(sHTML, StartField, EndField - StartField + 1)
' ... amount available.
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
sAmount = Mid(sHTML, StartField, EndField - StartField + 1)
sBacks(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")"
Next QuoteNo
For QuoteNo = 1 To 3
'Lay price ...
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
sQuote = Mid(sHTML, StartField, EndField - StartField + 1)
'... amount available.
StartField = InStr(EndField, sHTML, ",") + 1
EndField = InStr(StartField + 1, sHTML, ",") - 1
sAmount = Mid(sHTML, StartField, EndField - StartField + 1)
sLays(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")"
Next QuoteNo
' ... on to the next selection (if any).
SelectionNo = SelectionNo + 1
StartField = InStr(EndField, sHTML, "p.m_R")
Wend

'Copy the data collected in VBA arrays back to EXCEL ranges.
Cb: ThisWorkbook.Worksheets("Latest Snapshot").Range("EventName").Value =
sEName
ThisWorkbook.Worksheets("Latest Snapshot").Range("Selections").Value =
sSels
ThisWorkbook.Worksheets("Latest Snapshot").Range("Back").Value = sBacks
ThisWorkbook.Worksheets("Latest Snapshot").Range("Lay").Value = sLays

'Timestamp the data.
ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1,
1).Formula = "=Now()"
ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1,
2).Formula = "=Now()"

End Sub

Module2..................................................

Option Explicit
Public RunWhen As Double
Public RunIntervalSeconds As Integer
Public Const cRunWhat = "DataRefresh"
Public ShowNumber As Integer


Sub EngageWeb()
'Starts up the scheduling process: in the nature of an initialisation
routine.

'Check the workbook has valid sheet names allowing updates to be stored
sequentially.
If Not WorkSheetNameIntegrity() Then
MsgBox "Show number inconsistent with existing worksheet names."
Exit Sub
End If
'Change some of the EXCEL colour palette to match Betfair's show
scheme.
SetColourScheme

'Set the data acquisition interval from the parameter worksheet cell.
RunIntervalSeconds =
ThisWorkbook.Worksheets("Console").Range("RefreshInterval").Cells(1,
1).Value

'Determine the last show number.
ShowNumber = ThisWorkbook.Worksheets("Console").Range("Shows").Cells(1,
1).Value

'Obtain the latest show
DataRefresh

End Sub
Sub DataRefresh()

'Acquire data, parse out the latest prices and store them away.
ShowNumber = ShowNumber + 1
ThisWorkbook.Worksheets("Console").Range("Shows").Cells(1, 1).Value =
ShowNumber
GetExchangeShow


'Prime the next refresh, up to 500 shows.
If ShowNumber < 500 Then
StartTimer
Else
DisEngageWeb
End If

End Sub
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, RunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat,
schedule:=True
End Sub
Sub DisEngageWeb()
'Shuts down the scheduling process: in the nature of a closing routine.
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat,
schedule:=False
ThisWorkbook.ResetColors
End Sub
Function WorkSheetNameIntegrity() As Boolean
'The shows are stored in sheets having sequential integer names so we check
that ...
'... the stated number of shows gathered is not less than the maximum sheet
name.
'If there are no numeric sheet names the starting show number is set to 0.

Dim idx, Max, No As Integer

Max = -1
For idx = 1 To ThisWorkbook.Worksheets.Count
If IsNumeric(ThisWorkbook.Worksheets(idx).Name) Then
No = Val(ThisWorkbook.Worksheets(idx).Name)
If No > Max Then Max = No
End If
Next
If ThisWorkbook.Worksheets("Console").Range("Shows").Cells(1, 1).Value
< Max Then
WorkSheetNameIntegrity = False
Else
WorkSheetNameIntegrity = True
If Max = -1 Then
ThisWorkbook.Worksheets("Console").Range("Shows").Cells(1, 1).Value = 0
End If

End Function
Sub SetColourScheme()

'Alice blue for the market name.
ThisWorkbook.Colors(37) = RGB(217, 232, 234)
'Light and steel blues for back prices.
ThisWorkbook.Colors(33) = RGB(210, 225, 233)
ThisWorkbook.Colors(41) = RGB(177, 201, 216)
'Pinkish for lay prices.
ThisWorkbook.Colors(44) = RGB(234, 203, 219)
ThisWorkbook.Colors(40) = RGB(228, 189, 208)

End Sub

Module3............................................................
Option Explicit
Function GetExchangeData(sURL) As String
'Extract the HTML text containing the event data from the Betfair market
page ...
'... using the Microsoft Internet Controls (enable in
VBE/Tools/References).

Dim IeApp As InternetExplorer
Dim IeDoc As Object
Dim lStartSecs, lElapsedSecs, lTimeOutSecs As Long

'In case an unexpected error occurs ... say the user accidentally
closes the show web page.
'The string returned is an error message in place of an event name, one
without contestants.
GetExchangeData = "p.m_M, 'Data collection failed.'"
On Error GoTo cl

'Create a new instance of IE & make it visible: some things don¢t work
unless it¢s visible.
Set IeApp = New InternetExplorer
IeApp.Visible = True

'Call up the page required ... give it time to load (90% of the refresh
interval).
lTimeOutSecs = RunIntervalSeconds * 0.9
lStartSecs = Timer()
IeApp.Navigate sURL
Do
lElapsedSecs = Timer() - lStartSecs
If lElapsedSecs < 0 Then lElapsedSecs = lElapsedSecs + 60 * 60 * 24
'period spanning 12A.M.
Loop Until IeApp.ReadyState = READYSTATE_COMPLETE Or lElapsedSecs >
lTimeOutSecs

If lElapsedSecs > lTimeOutSecs Then
GetExchangeData = "p.m_M, 'Web access timed out.'"
Else
'Store the page's Document Object ... and see if it looks like a
market has loaded.
Set IeDoc = IeApp.Document
If InStr(IeDoc.documentElement.innerHTML, "p.m_M") = 0 Then
GetExchangeData = "p.m_M, 'Invalid market ID.'"
Else
'Grab the text (inside the first script).
GetExchangeData = IeDoc.Scripts(0).Text
End If
Set IeDoc = Nothing
End If

'Close the IE window and clean up storage.
IeApp.Quit
Set IeApp = Nothing

cl: lStartSecs = 0 'Couldn't find a NULL statement!

End Function

Module4..............................................................

Sub The_Sub()
Sheets("Latest Snapshot").Select
Range("J3:J17").Select
Selection.Copy
Sheets("Chartdata").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("O2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))
Sheets("Latest Snapshot").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Chartdata").Select
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Wait (Now + TimeValue("0:00:30"))

End Sub

 

[Guest]

After reading your posts so many times, we think this is what you want
for i = 1 to 15
read the web
take snapshot
write to cells(2, i+1) 'i+1 = B, i+2 = C, etc
wait 30 sec
next i

your first post failed because there was no waiting, you put all 15 write in
one operation.

 

[Saxman]

After reading your posts so many times, we think this is what you want
for i = 1 to 15
read the web
take snapshot
write to cells(2, i+1) 'i+1 = B, i+2 = C, etc
wait 30 sec
next i

your first post failed because there was no waiting, you put all 15 write in
one operation.

This works fine with the help of another poster.

Sub The_Sub()
For i = 2 to 17
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").cells(2,i).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:30"))
Next i
End sub

For i = 2 to 17, as I need the first column for chart reference.

I just need to incorporate this routine into the main macro somehow. I
dare say it will be hit and miss, as I have two timed events running
simultaneously. Eventually, if I get things running smoothly (with your
help!), both events will be set to the same time interval.

Thanks!!

Thanks for the feedback.

 

[PY & Associates]

That is also ours.
2 to 17 (should be 16) is because we used cells(2, i)
1 to 15 is because we used cells(2, i+1) here

you DO NOT need two 'timed' action.
you only need this one.

 

[Saxman]

That is also ours.
2 to 17 (should be 16) is because we used cells(2, i)
1 to 15 is because we used cells(2, i+1) here

you DO NOT need two 'timed' action.
you only need this one.

Not sure what you mean. The data is gathered according to a user setting
on the "Console" worksheet. Can they both be incorporated into one
routine. (i.e. with the code below)?

You should be able to see the coding for data gathering in my original post
which has the full code attached.


Thanks again!

 

[PY & Associates]

We would very much like to assist, but find it very difficult to trace
through the code without knowing the work flow. There are plenty of
cosmetics (coloring, etc) which distract us. We prefer to give you logics
and you put them in the right position.

when data is read, it becomes static. Whether you write it immediately or a
few seconds later, they do not change.

You must wait a few seconds to read the data again so that they have time to
refresh.

so you read the web (I must look back to your OP Nearly there, with Chip's
code), take a snapshot (optional), write to chartdata, one step after
another, no need to pause.

Now you wait before you read the web again.
but you have to shift data one column to the right, so you need an increment
counter i for the loop

Sit back and think over it please.

 

[Saxman]

We would very much like to assist, but find it very difficult to trace
through the code without knowing the work flow. There are plenty of
cosmetics (coloring, etc) which distract us. We prefer to give you logics
and you put them in the right position.

I did not write the original code, so I cannot help in this respect. The
formatting is not important, just the numbers.

few seconds later, they do not change.

You must wait a few seconds to read the data again so that they have time to
refresh.

so you read the web (I must look back to your OP Nearly there, with Chip's
code), take a snapshot (optional), write to chartdata, one step after
another, no need to pause.

Now you wait before you read the web again.
but you have to shift data one column to the right, so you need an increment
counter i for the loop

Sit back and think over it please.

This is it simply:-

1, Read data from web, put data in "Snapshot", then copy to "Chartdata".
2, Wait 30 sec (or time set by user) for web data to refresh.
3, Repeat #1, but put data one column to the right of "Chartdata".

The code for getting the web data and pasting to "Snapshot" and refreshing
works OK. The code for copying from "Snapshot" to "Chartdata" works OK
when run independently from the main code (offline). I just need to run
them both together.

The data refresh on the website refreshes every 60 seconds by default.

I have been to the gym in the meantime. I think the gym is easier?

Thanks again.

 

[Saxman]

I have placed the following routine into the all the Modules in all
positions, it is ignored, but data collection is not affected.

Sub The_Sub()
For i = 2 To 17
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").Cells(2, i).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:10"))
Next i
End Sub

If I paste the follow into an existing routine, I get variable/syntax
errors on the first line.

For i = 2 To 17
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").Cells(2, i).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:10"))
Next i

The above needs to be written into the main code I think.

Module1 gets the data and puts it into "Snapshot" and formats the colours.

Module2 sets the refresh rate and changes the colours if data gathering is
stopped. (The original spreadsheet did create a new worksheet for each set
of new data, but I have now ommited it from the code, so there might be
references to new sheets).

Module3 Cleans up data before new data gathering is re-started and provides
alternatives incase of user input errors.

 

[PY & Associates]

treat each of your modules as subroutines
if each of them works by itself, then

sub main()
for i = 1 to 15
read web subroutine 'just read, do not create new sheets
snapshot subroutine 'ditto
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").Cells(2, i+1).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:60"))
Next i
end sub

if you comment out read web and snapshot, change time value to 2 sec, you
can speed up testing.
then un-comment snapshot
then un-comment read web
you can then know where problem comes in

I am going to office now.
send further information to my private address, if you want.
I do not keep watching NG all day

 

[Saxman]

treat each of your modules as subroutines
if each of them works by itself, then

sub main()
for i = 1 to 15
read web subroutine 'just read, do not create new sheets
snapshot subroutine 'ditto
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").Cells(2, i+1).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:60"))
Next i
end sub

Sub main()
For i = 1 To 15
'read web subroutine 'just read, do not create new sheets
'snapshot subroutine 'ditto
Sheets("Latest Snapshot").Range("J3:J17").Copy
Sheets("Chartdata").Cells(2, i + 1).PasteSpecial Paste:=xlPasteValues
Application.Wait (Now + TimeValue("0:00:02"))
Next i
End Sub

The above works fine when tested in a new module. Sometimes when I try to
test this, I am prompted for a macro name. How do I assign it a macro
name? It might run when incorporated with the main code or placed in a new
module?

When I paste it into an existing module and test it, I get a Compile Error
(Variable not defined @ For i = 1 To 15
).

if you comment out read web and snapshot, change time value to 2 sec, you

I have now done that.