Code in RTG3.xlsm is more or less the same except Module2 where we get quotes from Google Finance. You can see the complexity. If anybody can help in further optimising, that person is welcome.
Sub GetGoogleData()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim C As Integer, R As Integer, S As String, t As String, CellValue As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
DeleteAllQueries
Set DataSheet = MyBook.Sheets("Google")
MyBook.Sheets("Now").Select
i = 7
qurl = "http://finance.google.com/finance/info?client=ig&q="
While Cells(i, "H") <> ""
qurl = qurl + "NSE:" + Cells(i, "H") + ","
i = i + 1
Wend
qurl = Left(qurl, Len(qurl) - 1) 'remove last comma
Range("I1") = qurl
QueryQuote:
With MyBook.Sheets("Google").QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("L1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
'Setting BackgroundQuery False makes it so that the code will block on the refresh call, _
so that it will wait until the query is done executing before continuing onto the rest of the code.
.SaveData = True
End With
With MyBook.Sheets("Google")
.Range("A2").CurrentRegion.ClearContents
End With
With MyBook.Sheets("Google").Range("L:O")
.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:=" GMT+05:30", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
With MyBook.Sheets("Google").Range("L:L")
.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="""", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5 _
, 1)), TrailingMinusNumbers:=True
End With
With MyBook.Sheets("Google")
i = 1
For i = 1 To .Range("M65536").End(xlUp).Row
If .Cells(i, "M").Value = "t" Then
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("A65536").End(xlUp).Offset(1, 0)
End If
If .Cells(i, "M").Value = "l" Then
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("B65536").End(xlUp).Offset(1, 0)
End If
If .Cells(i, "M").Value = "ltt" Then
S = .Cells(i, "O")
S = Left(S, Len(S) - 2) & " " & Right(S, 2)
.Cells(i, "O") = S
.Cells(i, "O").Copy Destination:=MyBook.Sheets("Google").Range("C65536").End(xlUp).Offset(1, 0)
End If
Next i
End With
' turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
' Google gives Time in HH:MM format hence add 3 seconds every time
If IST <> Range("I7") Then
'Debug.Print IST & "- " & Range("R7") & "-" & Secs
IST = Range("I7")
Secs = RP
Else
Secs = Secs + TimeValue("00:00:03")
End If
End Sub
Sub DeleteAllQueries()
Dim qt As QueryTable
Dim WSh As Worksheet
For Each WSh In ThisWorkbook.Worksheets
For Each qt In WSh.QueryTables
qt.Delete
Next qt
Next WSh
End Sub