?
Solved

out of range error

Posted on 2012-08-21
4
Medium Priority
?
587 Views
Last Modified: 2012-08-21
Hello. I get an out of range error in the attached macro. I got this macro from the web. It is suppose to get prices from Google finance. I filled in cells b2, b3, and b4 with

2012-06-01
2012-08-22
COKE

respectively.

Also
there are 3 lines that I commented out since they seem to call some stuff which is not defined:
    'UpdateScale
    'UpdateScale2
    'UpdateScale3

I get an out of range error.
Also, I get some strange characters in the first cell. It is suppose to have 'Date' but it has

'¿¿Date'

Any help would be appreciated.
Sub GetData()
'   thanks to Ron McEwan :^)

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name
    Dim LastRow As Long
    Dim X As Range
    Dim B4 As String
    Dim i As Long, endRow As Long, j As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    complete = False
    bSymbolNotFound = False 'Greg Lovern
    
    Set DataSheet = ActiveSheet
  
        StartDate = DataSheet.Range("B2").Value
        EndDate = DataSheet.Range("B3").Value
        Symbol = DataSheet.Range("B4").Value
        Range("C7").CurrentRegion.ClearContents
        
'construct the URL for the query
        
        'Google
        qurl = "http://finance.google.com/finance/historical?q=" & Symbol
        qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
               "+" & Day(StartDate) & "+" & Year(StartDate) & _
               "&enddate=" & MonthName(Month(EndDate), True) & _
               "+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"

        'Yahoo
'        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
'        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
'            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
'            Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("P2") & "&q=q&y=0&z=" & _
'            Symbol & "&x=.csv"
        Range("b5") = qurl
                   
QueryQuote:

            'Web query
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                On Error GoTo BadSymbol 'Greg Lovern
                .Refresh BackgroundQuery:=False
                On Error GoTo 0 'Greg Lovern
                .SaveData = True
            End With
            
            Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False
            
            Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
            Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
            Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
            Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"
            
            'If Google doesn't return "Adjusted Close", fill col I with "Close" values
            endRow = Range("G65536").End(xlUp).Row
            If DataSheet.Cells(endRow, "I") = "" Then
               For i = 7 To endRow
                   DataSheet.Cells(i, "I").Value = DataSheet.Cells(i, "G").Value
               Next
            End If


    With ThisWorkbook
        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery
    End With
    
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    
'    Range("C7:I2000").Select
'    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
'        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("C7:I2000").Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Greg Lovern

'    Range("C1").Select
'    Selection.ColumnWidth = 12
    Range("C1").ColumnWidth = 12 'Greg Lovern
    
    'UpdateScale
    'UpdateScale2
    'UpdateScale3
    Range("B4").Select
  
LastRow = Cells(Rows.Count, "I").End(xlUp).Row
Range("BG7").FormulaR1C1 = "=AVERAGE(R" & LastRow - Range("P5") + 1 & "C[-50]:R" & LastRow & "C[-50])"

'On Error Resume Next
'Range("H4").ClearContents
'Set x = Range("I" & Rows.Count).End(xlUp)
'Range("H4") = x / x.Offset(-Range("L6").Value)
'On Error Resume Next

If Sheets("Candles").Range("B4").Value = "DIA" Then

    Sheets("Candles").Range("F4").ClearContents 'entry date dow return.
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    
    Sheets("Candles").Range("F4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1
    Sheets("Candles").Range("H4").ClearContents
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    Sheets("Candles").Range("H4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1
    
    Sheets("Candles").Range("D2").ClearContents
    Sheets("Candles").Range("D2") = Sheets("Candles").Range("F3")
    
    Sheets("Candles").Range("D3").ClearContents
    Sheets("Candles").Range("D3") = Sheets("Candles").Range("G3")
   
ElseIf Sheets("Candles").Range("B4").Value <> "DIA" Then

    Sheets("Candles").Range("H4").ClearContents 'last close dow return.
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    Sheets("Candles").Range("H4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1

End If



'With ActiveSheet
    'LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
    '.Range("H4").Value = .Cells(LastRow, "I").Value / .Cells(LastRow - Range("L6").Value, "I").Value
'End With

Exit Sub 'Greg Lovern

BadSymbol: 'Greg Lovern
bSymbolNotFound = True
MsgBox "Symbol " & Symbol & " not found.", vbCritical + vbOKOnly, "Symbol Not Found" 'Greg Lovern
Application.Calculation = xlCalculationAutomatic 'Greg Lovern
Application.DisplayAlerts = True 'Greg Lovern
    
End Sub

Open in new window

Sub GetData()
'   thanks to Ron McEwan :^)

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name
    Dim LastRow As Long
    Dim X As Range
    Dim B4 As String
    Dim i As Long, endRow As Long, j As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    complete = False
    bSymbolNotFound = False 'Greg Lovern
    
    Set DataSheet = ActiveSheet
  
        StartDate = DataSheet.Range("B2").Value
        EndDate = DataSheet.Range("B3").Value
        Symbol = DataSheet.Range("B4").Value
        Range("C7").CurrentRegion.ClearContents
        
'construct the URL for the query
        
        'Google
        qurl = "http://finance.google.com/finance/historical?q=" & Symbol
        qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
               "+" & Day(StartDate) & "+" & Year(StartDate) & _
               "&enddate=" & MonthName(Month(EndDate), True) & _
               "+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"

        'Yahoo
'        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
'        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
'            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
'            Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("P2") & "&q=q&y=0&z=" & _
'            Symbol & "&x=.csv"
        Range("b5") = qurl
                   
QueryQuote:

            'Web query
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                On Error GoTo BadSymbol 'Greg Lovern
                .Refresh BackgroundQuery:=False
                On Error GoTo 0 'Greg Lovern
                .SaveData = True
            End With
            
            Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False
            
            Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
            Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
            Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
            Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"
            
            'If Google doesn't return "Adjusted Close", fill col I with "Close" values
            endRow = Range("G65536").End(xlUp).Row
            If DataSheet.Cells(endRow, "I") = "" Then
               For i = 7 To endRow
                   DataSheet.Cells(i, "I").Value = DataSheet.Cells(i, "G").Value
               Next
            End If


    With ThisWorkbook
        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery
    End With
    
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    
'    Range("C7:I2000").Select
'    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
'        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("C7:I2000").Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Greg Lovern

'    Range("C1").Select
'    Selection.ColumnWidth = 12
    Range("C1").ColumnWidth = 12 'Greg Lovern
    
    'UpdateScale
    'UpdateScale2
    'UpdateScale3
    Range("B4").Select
  
LastRow = Cells(Rows.Count, "I").End(xlUp).Row
Range("BG7").FormulaR1C1 = "=AVERAGE(R" & LastRow - Range("P5") + 1 & "C[-50]:R" & LastRow & "C[-50])"

'On Error Resume Next
'Range("H4").ClearContents
'Set x = Range("I" & Rows.Count).End(xlUp)
'Range("H4") = x / x.Offset(-Range("L6").Value)
'On Error Resume Next

If Sheets("Candles").Range("B4").Value = "DIA" Then

    Sheets("Candles").Range("F4").ClearContents 'entry date dow return.
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    
    Sheets("Candles").Range("F4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1
    Sheets("Candles").Range("H4").ClearContents
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    Sheets("Candles").Range("H4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1
    
    Sheets("Candles").Range("D2").ClearContents
    Sheets("Candles").Range("D2") = Sheets("Candles").Range("F3")
    
    Sheets("Candles").Range("D3").ClearContents
    Sheets("Candles").Range("D3") = Sheets("Candles").Range("G3")
   
ElseIf Sheets("Candles").Range("B4").Value <> "DIA" Then

    Sheets("Candles").Range("H4").ClearContents 'last close dow return.
    Set X = Sheets("Candles").Range("I" & Rows.Count).End(xlUp)
    Sheets("Candles").Range("H4") = X / X.Offset(-Sheets("Candles").Range("L6").Value) - 1

End If



'With ActiveSheet
    'LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
    '.Range("H4").Value = .Cells(LastRow, "I").Value / .Cells(LastRow - Range("L6").Value, "I").Value
'End With

Exit Sub 'Greg Lovern

BadSymbol: 'Greg Lovern
bSymbolNotFound = True
MsgBox "Symbol " & Symbol & " not found.", vbCritical + vbOKOnly, "Symbol Not Found" 'Greg Lovern
Application.Calculation = xlCalculationAutomatic 'Greg Lovern
Application.DisplayAlerts = True 'Greg Lovern
    
End Sub

Open in new window

0
Comment
Question by:willie108
  • 2
  • 2
4 Comments
 
LVL 35

Accepted Solution

by:
Norie earned 2000 total points
ID: 38318841
The code is looking for a worksheet called 'Candles' in the workbook, do you have one?

If you don't have such a worksheet comment out lines 111-134 and the code should work.

I think the subs UpdateScale, UpdateScale2, UpdateScale3 and the worksheet 'Candles' worksheet might be something to do with a (candle?) chart
0
 

Author Comment

by:willie108
ID: 38318876
Thanks!

Do you know about those extra characters?
0
 
LVL 35

Expert Comment

by:Norie
ID: 38318885
Forgot about that part.

I've no idea what the characters are but I've seen that sort of thing when downloading data from the web.

It doesn't seem to affect anything and only seems to happen now and again, so I tend to ignore it.
0
 

Author Closing Comment

by:willie108
ID: 38318891
many  thanks.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question