Hi,

I want to set up an excel ssheet to automatically pull price data from a
website into a cell. Furthermore, each day I want the new price to be added
into the next available cell down from yesterday's update, in order for me to
keep a historical record and graph it.

Eg. on 2 Jan I want the script to update the gold price from
http://www.kitco.com/market/ to cell B5 and save. On 3 Jan I want it to
update the price into cell B6 and save, without overwriting B5, and so on.

Is this possible (using a macro or something), and if so what must I do.

Please provide easy to follow steps as I'm clueless! (-;

Thanks,

Please provide easy to follow steps as I'm clueless! (-;

OK I'll get you started. I don't know how to do the internet fetch
thing but I can get a simple automation framework going. Let me know
if I'm pitching this too low :)

1. Open your spreadsheet and set up some formatting and headings
around where you want your data to go. I'm going to assume that A4 is
the date column heading and B4 is the gold price column heading. Make
sure you format your date column so that the date displays the way you
want it to, or you'll just see "######".
2. Hit Alt-F11, or select the Tools-Macro-Visual Basic Editor menu
option
3. Double-click on the entry for the sheet that you have set up, e.g.
"Sheet1" or "GoldPrice" or whatever you called it. I'm going to assume
it's the latter, "GoldPrice".
4. Enter the following code:

Sub GetGoldPrice()
Range("A4").Activate
While Selection < "" And Selection < Date
Selection.Range("A2").Activate ' go down 1 cell
Wend
Selection.Value = Format(Date, "DD MMM")
Selection.Range("B1").Activate ' Move across 1 cell
' Get the gold price and enter it
End Sub

3. Double-click on the "ThisWorkBook" entry in the VBAProject window
on the left side
4. Select "Workbook" in the drop-down menu above the code editor
window, this should automatically create a Workbook_Open() function
declaration
5. Enter the following code:

Private Sub Workbook_Open()
Sheets("GoldPrice").Activate
Run (Sheets("GoldPrice").CodeName & ".GetGoldPrice")
End Sub

Now you have a spreadsheet that automatically calls a macro whenever
it is opened. The macro that it calls selects the cell A4, moves down
until it either finds a blank cell or a cell with today's date in it,
and then moves across to the next column along. What you need now is
the code that fetches the data from the internet. I have no idea how
to do that!

Phil Hibbs.

I've just seen the "How to load page with specific date?" thread,
which gives an example of driving an Internet Explorer application
instance to fetch and parse a web page. Perhaps that will help with
the next stage.

Phil Hibbs.

A simple WebQuery should get this for you, followed by a simple routine to
copy the data to the last row on the prices sheet. Have a go with the
following, post back if not sure where to put it or how to run it.

Sub GetGoldPrice()
Dim wsWQ As Worksheet
Dim wsPrices As Worksheet
Dim qt As QueryTable
Dim wb As Workbook

Set wb = ActiveWorkbook
On Error Resume Next
Set wsWQ = wb.Worksheets("KitcoQuery")
If wsWQ Is Nothing Then
Set wsWQ = wb.Worksheets.Add
wsWQ.Name = "KitcoQuery"
End If


Set qt = wsWQ.QueryTables("KitcoGoldPrice")
If qt Is Nothing Then
If AddKitcoQT(wsWQ, qt) = False Then
MsgBox "Failed to add WebWuery"
Exit Sub
End If
Else
qt.BackgroundQuery = False
qt.Refresh
End If

Set wsPrices = wb.Worksheets("GoldPrices")
If wsPrices Is Nothing Then
Set wsPrices = wb.Worksheets.Add
wsPrices.Name = "GoldPrices"
wsPrices.Range("A1:H1").Value = wsWQ.Range("C4:J4").Value
End If

wsPrices.Parent.Activate
wsPrices.Activate

nLastRow = wsPrices.Range("A60000").End(xlUp).Row + 1

wsWQ.Range("C6:J6").Copy _
Destination:=wsPrices.Range(Cells(nLastRow, 1), _
Cells(nLastRow, 8))


End Sub

Function AddKitcoQT(ws, qt) As Boolean
On Error GoTo errH
Set qt = ws.QueryTables.Add(Connection:= _
"URL;http://www.kitco.com/market", Destination:=ws.Range("A1"))
With qt
.Name = "KitcoGoldPrice"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

AddKitcoQT = True
Exit Function
errH:
End Function


Regards,
Peter T

"angelfire20" wrote in message
...
Hi,

I want to set up an excel ssheet to automatically pull price data from a
website into a cell. Furthermore, each day I want the new price to be
added
into the next available cell down from yesterday's update, in order for me
to
keep a historical record and graph it.

Eg. on 2 Jan I want the script to update the gold price from
http://www.kitco.com/market/ to cell B5 and save. On 3 Jan I want it to
update the price into cell B6 and save, without overwriting B5, and so on.

Is this possible (using a macro or something), and if so what must I do.

Please provide easy to follow steps as I'm clueless! (-;

Thanks,

Peter T;630667 Wrote:

A simple WebQuery should get this for you, followed by a simple routine
to
copy the data to the last row on the prices sheet. Have a go with the
following, post back if not sure where to put it or how to run it.

Sub GetGoldPrice()
Dim wsWQ As Worksheet
Dim wsPrices As Worksheet
Dim qt As QueryTable
Dim wb As Workbook

Set wb = ActiveWorkbook
On Error Resume Next
Set wsWQ = wb.Worksheets("KitcoQuery")
If wsWQ Is Nothing Then
Set wsWQ = wb.Worksheets.Add
wsWQ.Name = "KitcoQuery"
End If


Set qt = wsWQ.QueryTables("KitcoGoldPrice")
If qt Is Nothing Then
If AddKitcoQT(wsWQ, qt) = False Then
MsgBox "Failed to add WebWuery"
Exit Sub
End If
Else
qt.BackgroundQuery = False
qt.Refresh
End If

Set wsPrices = wb.Worksheets("GoldPrices")
If wsPrices Is Nothing Then
Set wsPrices = wb.Worksheets.Add
wsPrices.Name = "GoldPrices"
wsPrices.Range("A1:H1").Value = wsWQ.Range("C4:J4").Value
End If

wsPrices.Parent.Activate
wsPrices.Activate

nLastRow = wsPrices.Range("A60000").End(xlUp).Row + 1

wsWQ.Range("C6:J6").Copy _
Destination:=wsPrices.Range(Cells(nLastRow, 1), _
Cells(nLastRow, 8))


End Sub

Function AddKitcoQT(ws, qt) As Boolean
On Error GoTo errH
Set qt = ws.QueryTables.Add(Connection:= _
"URL;http://www.kitco.com/market", Destination:=ws.Range("A1"))
With qt
.Name = "KitcoGoldPrice"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

AddKitcoQT = True
Exit Function
errH:
End Function


Regards,
Peter T

"angelfire20" wrote in message
...
Hi,

I want to set up an excel ssheet to automatically pull price data
from a
website into a cell. Furthermore, each day I want the new price to
be
added
into the next available cell down from yesterday's update, in order
for me
to
keep a historical record and graph it.

Eg. on 2 Jan I want the script to update the gold price from
'Live Market Quotes' (http://www.kitco.com/market/) to cell B5 and
save. On 3 Jan I want it to
update the price into cell B6 and save, without overwriting B5, and
so on.

Is this possible (using a macro or something), and if so what must I
do.

Please provide easy to follow steps as I'm clueless! (-;

Thanks,





I am working on a similar project, could you please share where the
different sections of code ought to be placed?

Thank you,

Scott


--
ScottO
------------------------------------------------------------------------
ScottO's Profile: http://www.thecodecage.com/forumz/member.php?u=2194
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175527

http://www.thecodecage.com/forumz


--- news://freenews.netfront.net/ - complaints: ---

Peter T;630667 Wrote:

A simple WebQuery should get this for you, followed by a simple routine
to
copy the data to the last row on the prices sheet. Have a go with the
following, post back if not sure where to put it or how to run it.

Sub GetGoldPrice()
Dim wsWQ As Worksheet
Dim wsPrices As Worksheet
Dim qt As QueryTable
Dim wb As Workbook

Set wb = ActiveWorkbook
On Error Resume Next
Set wsWQ = wb.Worksheets("KitcoQuery")
If wsWQ Is Nothing Then
Set wsWQ = wb.Worksheets.Add
wsWQ.Name = "KitcoQuery"
End If


Set qt = wsWQ.QueryTables("KitcoGoldPrice")
If qt Is Nothing Then
If AddKitcoQT(wsWQ, qt) = False Then
MsgBox "Failed to add WebWuery"
Exit Sub
End If
Else
qt.BackgroundQuery = False
qt.Refresh
End If

Set wsPrices = wb.Worksheets("GoldPrices")
If wsPrices Is Nothing Then
Set wsPrices = wb.Worksheets.Add
wsPrices.Name = "GoldPrices"
wsPrices.Range("A1:H1").Value = wsWQ.Range("C4:J4").Value
End If

wsPrices.Parent.Activate
wsPrices.Activate

nLastRow = wsPrices.Range("A60000").End(xlUp).Row + 1

wsWQ.Range("C6:J6").Copy _
Destination:=wsPrices.Range(Cells(nLastRow, 1), _
Cells(nLastRow, 8))


End Sub

Function AddKitcoQT(ws, qt) As Boolean
On Error GoTo errH
Set qt = ws.QueryTables.Add(Connection:= _
"URL;http://www.kitco.com/market", Destination:=ws.Range("A1"))
With qt
.Name = "KitcoGoldPrice"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

AddKitcoQT = True
Exit Function
errH:
End Function


Regards,
Peter T

"angelfire20" wrote in message
...
Hi,

I want to set up an excel ssheet to automatically pull price data
from a
website into a cell. Furthermore, each day I want the new price to
be
added
into the next available cell down from yesterday's update, in order
for me
to
keep a historical record and graph it.

Eg. on 2 Jan I want the script to update the gold price from
'Live Market Quotes' (http://www.kitco.com/market/) to cell B5 and
save. On 3 Jan I want it to
update the price into cell B6 and save, without overwriting B5, and
so on.

Is this possible (using a macro or something), and if so what must I
do.

Please provide easy to follow steps as I'm clueless! (-;

Thanks,




Thank you for the formula. I'm having similar problem too. Please
advice which one of the formula that can be adjust with other name of
sheet (so the formula can be available for any cases that similar).
Thank you :)


--
nggu
------------------------------------------------------------------------
nggu's Profile: http://www.thecodecage.com/forumz/member.php?u=2196
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175527

http://www.thecodecage.com/forumz


--- news://freenews.netfront.net/ - complaints: ---

Hi,

You can copy the code provided to a code module.
Open a workbook, press "Alt" and "F11" this should take you to the
Project.
In the "Tool" bar select "Insert", then select "Module". Now you can
copy the code provided to this module.
While still in the code module you can run the code from there. However
you will need too provide a "ShortCut" key other wise you will need to
run the code from the module.
Not knowing which version of "Excel" you are using, you can in 2007,
select "Developer" then select "Macro" and with the popup select
"Options" and now you can set the Shortcut key. Click Ok and you done.
Now save the workbook and you can use the shortcut key to run the
program.

I hope this helps.

Charles


--
CharlesH
------------------------------------------------------------------------
CharlesH's Profile: http://www.thecodecage.com/forumz/member.php?u=1354
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175527

http://www.thecodecage.com/forumz


--- news://freenews.netfront.net/ - complaints: ---