Code for realtime share price updates

[gylfih]

Hi, I've been writing this small program to pull realtime share prices from google finance based on a user-inputted company code. However, the first function I've defined (at the top) only works for AAPL, not any other company codes, and the second function (to find the price) has an object defined error. I'm quite new to VBA (only been using it for 4 days), any idea what I'm doing wrong?

Thanks,
Gylfi

Function ExtractCID(fcid As String) As Integer    Dim i As Integer, iCount As Integer
    Dim sText As String
    Dim lNum As String
     
    sText = fcid
     
    For iCount = Len(sText) To 1 Step -1
        If IsNumeric(Mid(sText, iCount, 1)) Then
            i = i + 1
            lNum = Mid(sText, iCount, 1) & lNum
        End If
         
        If i = 1 Then lNum = CInt(Mid(lNum, 1, 1))
    Next iCount
     
     
    ExtractCID = CInt(lNum)
End Function
Public Function TakePrice(fpri As String) As Single
    Dim s As String, i As Integer
    Dim fprice As String
    fprice = fpri
    
    For i = 1 To Len(fprice)
        If IsNumeric(Mid(fprice, i, 1)) Then
        Exit For
        End If
    Next i
    
    s = Mid(fprice, i, InStr(fprice, "</") - 1)
    TakePrice = Convert.ToSingle(s)
End Function


Sub Shares()
Dim EPIC As String
Dim fprice As String
Dim sPrice As Single
Dim pPrice As Single
Dim Shares As Integer
Dim Change As Single
Dim Cost As Single
Dim MktVl As Single
Dim LG As Single
Dim L As Single
Dim url As String
Dim StartNumber As Integer
Dim EndNumber As Integer
Dim x As String
Dim cid As Integer
Dim fcid As String
EndNumber = Application.CountA(Range("A:A"))
For StartNumber = 2 To EndNumber
    Sheet2.Cells(StartNumber, 1).Activate
    EPIC = ActiveCell.Value
    url = "http://www.google.com/finance?q=" & EPIC
With CreateObject("msxml2.xmlhttp")
    .Open "GET", url, False
    .send
    x = .ResponseText
End With
fcid = (Mid(x, InStr(1, x, "cid="), 15))
cid = ExtractCID(fcid)
Range("B4").Value = cid
fprice = Mid(x, InStr(1, x, cid & "_l") + Len(cid) + 3, 15)
sPrice = TakePrice(fprice)
ActiveCell.Offset(0, 1).Value = sPrice
pPrice = ActiveCell.Offset(0, 2).Value
Shares = ActiveCell.Offset(0, 3).Value
Cost = pPrice * Shares
ActiveCell.Offset(0, 4).Value = Cost
ActiveCell.Offset(0, 5).Value = ((sPrice - pPrice) / pPrice) * 100
MktVl = sPrice * Shares
ActiveCell.Offset(0, 6).Value = MktVl
ActiveCell.Offset(0, 7).Value = MktVl - Cost
L = ((MktVl - Cost) / Cost) * 100
ActiveCell.Offset(0, 8).Value = L
If L < 0 Then
    ActiveCell.Offset(0, 8).Interior.Color = RGB(255, 0, 0)
Else
    ActiveCell.Offset(0, 8).Interior.ColorIndex = xlNone
End If
Next StartNumber
End Sub

 

[gylfih]

Sorry, less than the entire code seems to have been posted above.

Function ExtractCID(fcid As String) As Integer
    Dim i As Integer, iCount As Integer
    Dim sText As String
    Dim lNum As String
     
    sText = fcid
     
    For iCount = Len(sText) To 1 Step -1
        If IsNumeric(Mid(sText, iCount, 1)) Then
            i = i + 1
            lNum = Mid(sText, iCount, 1) & lNum
        End If
         
        If i = 1 Then lNum = CInt(Mid(lNum, 1, 1))
    Next iCount
     
     
    ExtractCID = CInt(lNum)
End Function
Public Function TakePrice(fpri As String) As Single
    Dim s As String, i As Integer
    Dim fprice As String
    fprice = fpri
    
    For i = 1 To Len(fprice)
        If IsNumeric(Mid(fprice, i, 1)) Then
        Exit For
        End If
    Next i
    
    s = Mid(fprice, i, InStr(fprice, "</") - 1)
    TakePrice = Convert.ToSingle(s)
End Function


Sub Shares()
Dim EPIC As String
Dim fprice As String
Dim sPrice As Single
Dim pPrice As Single
Dim Shares As Integer
Dim Change As Single
Dim Cost As Single
Dim MktVl As Single
Dim LG As Single
Dim L As Single
Dim url As String
Dim StartNumber As Integer
Dim EndNumber As Integer
Dim x As String
Dim cid As Integer
Dim fcid As String
EndNumber = Application.CountA(Range("A:A"))
For StartNumber = 2 To EndNumber
    Sheet2.Cells(StartNumber, 1).Activate
    EPIC = ActiveCell.Value
    url = "http://www.google.com/finance?q=" & EPIC
With CreateObject("msxml2.xmlhttp")
    .Open "GET", url, False
    .send
    x = .ResponseText
End With
fcid = (Mid(x, InStr(1, x, "cid="), 15))
cid = ExtractCID(fcid)
Range("B4").Value = cid
fprice = Mid(x, InStr(1, x, cid & "_l") + Len(cid) + 3, 15)
sPrice = TakePrice(fprice)
ActiveCell.Offset(0, 1).Value = sPrice
pPrice = ActiveCell.Offset(0, 2).Value
Shares = ActiveCell.Offset(0, 3).Value
Cost = pPrice * Shares
ActiveCell.Offset(0, 4).Value = Cost
ActiveCell.Offset(0, 5).Value = ((sPrice - pPrice) / pPrice) * 100
MktVl = sPrice * Shares
ActiveCell.Offset(0, 6).Value = MktVl
ActiveCell.Offset(0, 7).Value = MktVl - Cost
L = ((MktVl - Cost) / Cost) * 100
ActiveCell.Offset(0, 8).Value = L
If L < 0 Then
    ActiveCell.Offset(0, 8).Interior.Color = RGB(255, 0, 0)
Else
    ActiveCell.Offset(0, 8).Interior.ColorIndex = xlNone
End If
Next StartNumber
End Sub