CODEWITHSUNDEEP
vbaexcelsplitdelimiter
J Moore
J Moore

Reputation: 55

Splitting Text By Rows and Columns

I am using an Excel macro to retrieve a CSV file from Yahoo Finance. In column A, I have the stock tickers listed as input. I used to run a macro that would insert each ticker into a URL then output the results into column B. Then I would call a function to split the text in column B into columns B through column E.

The function became much faster when I create a concatenated string of URLs and call the URL just once. The main problem is I am receiving the data in the following format:

"81.950,342.05B,"Exxon Mobil Corporation Common ",263.71B
81.38,201.29B,"Alibaba Group Holding Limited A",13.56B
754.77,519.78B,"Alphabet Inc.",71.76B
120.57,649.30B,"Apple Inc.",233.72B"

Current Output Current Output

Expected/Ideal Output Expected/Ideal Output

When I called the URL one ticker at a time, I could separate the necessary data out with the Text to Columns function. Now I need it separated by columns and rows.

Sub StockDataPull() 
Dim url As String
Dim http As Object
Dim LastRow As Long
Dim Symbol_rng As Range
Dim Output_rng As Range

'Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Application.ScreenUpdating = False

Set Symbol_rng = Range("A5:A" & LastRow).Cells
Set Output_rng = Range("C5:F" & LastRow).Cells

    'Open Yahoo Finance URL
        url = "http://download.finance.yahoo.com/d/quotes.csv?s=" & concatRange(Symbol_rng) & "&f=pj1ns6"
                Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", url, False
        http.Send
                    Output_rng = http.responseText
           Set http = Nothing
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
End Sub


'The code below is what I used before Sub StockDataPull(). This code calls a URL for each ticker, instead of one URL for all tickers in a concatenated string. It's considerably slower, but it works because it outputs the data two cells away from the ticker, then I call Sub Delimiter() to separate it across the next few consecutive columns.


Sub StockData()
Dim url As String
Dim http As Object
Dim LastRow As Long
Dim Symbol_rng As Range

''Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Application.ScreenUpdating = False

Set Symbol_rng = Range("A5:A" & LastRow).Cells

    For Each cell In Symbol_rng

    ''Open Yahoo Finance URL
        url = "http://download.finance.yahoo.com/d/quotes.csv?s=" & cell.Value & "&f=pj1ns6"

        Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", url, False
        http.Send

        cell.Offset(rowOffset:=0, columnOffset:=2) = http.responseText

        Set http = Nothing

    Next cell

        Application.DisplayAlerts = False    
        Application.ScreenUpdating = True    
        Call Delimiter            
    End Sub

Sub Delimiter()    
''Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

''Separate the data into four columns
    Range("C5:C" & LastRow).TextToColumns Destination:=Range("C5"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True

''Unwrap the text
    Range("C5:F" & LastRow).Select
    With Selection
        .WrapText = False
    End With

End Sub

Upvotes: 3

Views: 960

Answers (3)

GSazheniuk
GSazheniuk

Reputation: 1384

I understand this is not the best way to handle this type of problem, but it should work.

First of all we need to change your Delimiter sub (which is good!) so it can work with rows extracted from response:

Sub Delimiter(ByVal LastRow)
''Separate the data into four columns
    Range("B1:B" & LastRow).TextToColumns Destination:=Range("C1:C" & LastRow), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True

''Unwrap the text
    Range("B1:F" & LastRow).Select
    With Selection
        .WrapText = False
    End With

End Sub

And here is how to split your response in proper way:

Sub SplitToLines()
    s = Cells(1, "A")
    If Left(s, 1) = """" Then
        s = Mid(s, 2)
    End If

    If Right(s, 1) = """" Then
        s = Mid(s, 1, Len(s) - 1)
    End If

    resLines = Split(s, vbLf)

    For i = LBound(resLines) To UBound(resLines)
        Cells(i + 1, "B") = resLines(i)
    Next i
    Delimiter (i + 1)

End Sub

I just checked on your example and it works. All you need is to put your response in "A1" cell (or change the macro).

Let me know if you are having trouble with it.

Upvotes: 1

frostbite
frostbite

Reputation: 648

Zealous VB newbie alert.

Private Sub so_stub_1()
 'wsSo is the name of my test worksheet
  Dim hdr() As String: hdr = Split("Last Close Price, Market Cap, Company Name, Annual Revenue", ",")
  Dim data() As Variant: data = wsSO.Range("G1:G4")
  Dim i As Integer
  Dim r As Integer
  For i = 1 To UBound(data) 
    r = i + 1 'offset in my test sheet
    wsSO.Range("A" & r & ":D" & r) = Split(data(i, 1), ",")
 Next 'i 
End Sub

Upvotes: 0

genespos
genespos

Reputation: 3311

I'm not sure of what you need but you can try to extract the string you need with this function

Function ExtractText(ByVal Txt As String) As String
    Txt = Right(Txt, Len(Txt) - InStr(1, Txt, ",""", vbTextCompare) - 1)
    Txt = Left(Txt, InStr(1, Txt, """,", vbTextCompare) - 1)
End Function

This extract the company name from the original string you get in the table.

Hope it helps

Upvotes: 0

Related Questions