run-time error 9': subscript out of range

V

vishu

Board Regular
Joined
Oct 26, 2011
Messages
74
Office Version
  1. 2016
Platform
  1. Windows
Hello, everyone,
Am getting subscript out of range error
and below line gets highlighted
csv_rows = Filter(csv_rows, csv_rows(0), False)

please if you could help me out


VBA Code: 
   Sub ExtractData()
    Dim Symbols As String
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer

    
    nColumns = 6
    csv_rows = Filter(csv_rows, csv_rows(0), False)


    ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
     
    For iRows = LBound(csv_rows) To UBound(csv_rows)
        CSV_Fields = Split(csv_rows(iRows), ",")
        If UBound(CSV_Fields) > nColumns Then
            nColumns = UBound(CSV_Fields)
            ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
        End If
    
        For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
            If IsNumeric(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
            ElseIf IsDate(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
            Else
                resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
            End If
        Next
    Next
 
    Sheets("Calculations").Select
    Range("A1000000").End(xlUp).Offset(OffsetCounter, 0).Select
    Selection.Resize(UBound(resultArray, 1) + 1, UBound(resultArray, 2) + 1).Value = resultArray
    
    Range("H1000000").End(xlUp).Offset(OffsetCounter, 0).Select
    Selection.Resize(UBound(resultArray, 1) + 1, 1).Value = Symbols
    
        End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
csvrows is undimensioned at that point. Given that there's nothing to filter, what is the point of that line?
 
Upvote 0
RoryA said:
csvrows is undimensioned at that point. Given that there's nothing to filter, what is the point of that line?
Click to expand...
Hi, thank you very much you answered one of my threads and asked for help but no response
below am giving my complete code, and I'll explain my problem. hope you will help

Earlier have asked questions about pulling data from yahoo. Have resolved that problem. Now trying to extract multiple data from one sheet to another there am not getting full success
Let me try to explain you all
I have a "Download" sheet Column "A" has Stocklist when am clicking the "Download All" button it extracts all stock data and the Last 5 days' data shows to K5:P10 and that data copy and paste to the "Calculation" sheet Column "A:F" which also getting paste.

But here my problem start

The "Download" Sheet doing its job perfectly but the "calculation" sheet does not paste correctly, only the last stock pastes fully 5 days of data and the rest only pastes 1 day of data. This is incorrect 5 days of data for each stock need to be pasted into the "calculation" sheet.

VBA code for your reference, please help me to solve this problem. if there is any way ill share my file also as other forums have uploaded my file

Pull Yahoo Multiple stock data (Old version code not working)
Thanks in advance

VBA Code: 
'Copyright 2008-2018 ConnectCode Pte Ltd. All Rights Reserved.
'This source code is protected by International Copyright Laws.
Dim gError As Integer

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

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim Symbol As String
    Dim i As Integer, N As Integer, p As Integer
    
        Dim last As Double
        Dim OffsetCounter As Double
    
  
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    
    Set DataSheet = ActiveSheet
     
    
        Set QuerySheet = Sheets("Download")
        Set DataSheet = Sheets("Calculations")
        With QuerySheet
        last = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

    
    
   
    N = Range("C1")

    Clear                           ' clear old data
    Init                         ' paste headings
   ' ExtractData
' ----------------------------------

For i = 1 To N
    
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
    Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
    Application.ScreenUpdating = False
   
    Range("K5:P10").Select           ' collect calculations
    Selection.Copy
       
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 2, 1).Select      ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
    Application.ScreenUpdating = True
    
    
        OffsetCounter = 1
        Call ExtractData(Symbol, OffsetCounter)

    
Next i

    Range("A1").Select
    Selection.ClearContents

DataSheet.Columns("A:F").AutoFit

    Sheets("Calculations").Select
    Formats
    Range("C1").Select

End Sub

Sub GetOne(ByVal Symbol As String, ByVal startDate As Date, ByVal endDate As Date, ByVal desti As String, ByVal freq As String)
    
    On Error GoTo ErrHandler:
    
    Dim crumb               As String
    Dim cookie               As String
    Dim response               As String
    Dim strUrl As String
    Dim DownloadURL As String
    Dim period1, period2 As String
    Dim httpReq As WinHttp.WinHttpRequest
    Dim nQuery As Name

    Set httpReq = New WinHttp.WinHttpRequest
    
    DownloadURL = "https://finance.yahoo.com/lookup?s=" & Symbol
    With httpReq
        .Open "GET", DownloadURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send
        .waitForResponse
        response = .ResponseText
        cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
    End With

    period1 = (startDate - DateValue("January 1, 1970")) * 86400
    period2 = (endDate - DateValue("January 1, 1970")) * 86400
    
    Dim counter As Long
    Dim startCounter As Long
    Dim result As String
    Dim dataResult As String
    Dim startResult As String
        
    crumb = Chr(34) & "CrumbStore" & Chr(34) & ":{" & Chr(34) & "crumb" & Chr(34) & ":" & Chr(34)
    startCounter = InStr(response, crumb) + Len(crumb)
    While Mid(response, startCounter, 1) <> Chr(34)
        result = result & Mid(response, startCounter, 1)
        startCounter = startCounter + 1
    Wend
    
    crumb = result
    DownloadURL = "https://query1.finance.yahoo.com/v7/finance/download/" & Symbol & "?period1=" & period1 & "&period2=" & period2 & "&interval=" + freq + "&events=history&crumb=" & crumb
    
    startResult = ""
    startCounter = 0
    While (startResult <> "Date" And startCounter < 8)
        With httpReq
            .Open "GET", DownloadURL, False
            .setRequestHeader "Cookie", cookie
            .send
            .waitForResponse
            dataResult = .ResponseText
        End With
        startResult = Mid(dataResult, 1, 4)
        startCounter = startCounter + 1
    Wend
    
    If (startResult <> "Date") Then
        noErrorFound = 0
        GoTo ErrHandler
    End If
    
    dataResult = Replace(dataResult, ",", vbTab)

    Dim dataObj As New DataObject
    dataObj.SetText dataResult
    dataObj.PutInClipboard
            
    Set currentWorksheet = ThisWorkbook.ActiveSheet
    Set currentRange = currentWorksheet.Range("C7")
    dataObj.GetFromClipboard
    currentRange.PasteSpecial
        
    noErrorFound = 1
    
ErrHandler:
    If noErrorFound = 0 Then
        Application.ScreenUpdating = True
      '  MsgBox ("Stock " + Symbol + "DONE")
    End If
    Resume Next
    
      Range("C1:I1").Select
    Selection.ColumnWidth = 8
    
'turn calculation back on

    Application.DisplayAlerts = True
    Range("C8:I600").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    RemoveNames
    'UpdateScale
Range("A1").Select

End Sub





    Sub ExtractData(Symbols As String, OffsetCounter As Double)
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer

    
    nColumns = 6
     csv_rows = Filter(csv_rows, csv_rows(0), False)


    ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
     
    For iRows = LBound(csv_rows) To UBound(csv_rows)
        CSV_Fields = Split(csv_rows(iRows), ",")
        If UBound(CSV_Fields) > nColumns Then
            nColumns = UBound(CSV_Fields)
            ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
        End If
    
        For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
            If IsNumeric(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
            ElseIf IsDate(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
            Else
                resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
            End If
        Next
    Next
 
    Sheets("Calculations").Select
    Range("A1000000").End(xlUp).Offset(OffsetCounter, 0).Select
    Selection.Resize(UBound(resultArray, 1) + 1, UBound(resultArray, 2) + 1).Value = resultArray
    
    Range("H1000000").End(xlUp).Offset(OffsetCounter, 0).Select
    Selection.Resize(UBound(resultArray, 1) + 1, 1).Value = Symbols
    
        End Sub





Sub RemoveNames()

Dim nQuery As Name

        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery

End Sub
Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo

    Sheets("Calculations").Select  ' move to Calculations sheet
    Worksheets("Calculations").Range("A1:F600").ClearContents      ' CLEAR OLD STUFF

    Worksheets("Download").Range("C8:I600").ClearContents      ' CLEAR OLD STUFF

    
    Formats
    Sheets("Download").Select      ' move back
    
End Sub



Sub Init()

' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'

    Range("K3:P10").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("A1:P2000").Select
    ActiveSheet.Paste
    
    Sheets("Download").Select
End Sub

Sub DownloadData()
     Application.ScreenUpdating = False
     Dim freqFlag As String
     Dim numRows As Integer
     Dim noErrorFoundInDownloadData As Integer
     noErrorFoundInDownloadData = 0
    
     On Error GoTo ErrHandlerDownloadData:
    
     freqFlag = "1d"
     If Worksheets("Download").Range("$B$5") = 1 Then
        freqFlag = "1d"
        'plus 2 due to the intitial two rows
        numRows = DateDiff("d", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 2 Then
        freqFlag = "1wk"
        numRows = DateDiff("w", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 3 Then
        freqFlag = "1mo"
        numRows = DateDiff("m", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     End If
     
     
     Worksheets("Download").Select
    ' Worksheets("Download").UsedRange.Clear
 
     'Stock 1
     If Worksheets("Download").Range("$C$13") <> "NONE" Then

     Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
     
     End If
     
     Range("C7").Select
            
     Columns("C:J").EntireColumn.AutoFit
          
     
     Dim vvx As Integer
     vvx = Application.Version
            
     If (vvx >= 12) Then
      'Excel 2007
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Add Key:=Range("C8:C6550") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("Download").Sort
         .SetRange Range("C7:J65500")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
     Else
      'Exel 2003
      Columns("C:J").Select
      Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
     End If
     
     'End If
     Worksheets("Download").Select
     Worksheets("Download").Range("J8").Select
     
    noErrorFoundInDownloadData = 1
    Application.ScreenUpdating = True
ErrHandlerDownloadData:
  
End Sub
Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'

'
    Range("A1:P1").Select
    Selection.Copy
    Range("A10:P6000").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
    Range("A1").Select
    Selection.ClearContents
    
End Sub
 
Upvote 0
None of that answers my question. You're trying to filter an array that hasn't even been initialised. Why?
 
Upvote 0
RoryA said:
None of that answers my question. You're trying to filter an array that hasn't even been initialised. Why?
Click to expand...
sorry, I don't know much about coding, have found 2 codes on the internet and my tried to merge them to get my expected result but failed. Really don't know what's the use of that line :(
 
Upvote 0
RoryA said:
None of that answers my question. You're trying to filter an array that hasn't even been initialised. Why?
Click to expand...
I did some changes and removed unwanted code. still not able to solve the problem. I know this part of code where am missing something please help me out

VBA Code: 
For i = 1 To N
    
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
    Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
    Application.ScreenUpdating = False
   
    Range("K5:P10").Select           ' collect calculations
    Selection.Copy
       
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 2, 1).Select      ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
    Application.ScreenUpdating = True
    
Next i

    Range("A1").Select
    Selection.ClearContents

DataSheet.Columns("A:F").AutoFit

    Sheets("Calculations").Select
    Formats
    Range("C1").Select
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Excel VBA for Yahoo Finance
Replies
5
Views
1K
alansidman
alansidman
V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
239
vanessavalentino83
V
H
  • Solved
Splitting Data into Workbooks - EDIT HELP
Replies
1
Views
443
horrellbt01
H
N
  • Solved
How to Merge Multiple VBA scripts as one?
Replies
7
Views
387
StephenCrump
S
N
  • Question Question
VBA Split and Fill only doing one line at a time. Help.
Replies
2
Views
295
NeoSez
N

Forum statistics

Threads
1,226,693
Messages
6,192,460
Members
453,725
Latest member
cvsdatreas

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top