VBA for TEXT to COLUMNS EXCEL

vjvijay88

New Member
Joined
Aug 17, 2016
Messages
22
I have code which downloads data from web and save in main workbook but data is not in format as table kindly look through and help me to correct problem.

my code is below
Code:
Sub DownloadStockFuturesQuotes(ByVal stockTicker As String, ByVal StartDate As Date, ByVal EndDate As Date, ByVal DestinationCell As String, ByVal frequency As String)


Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear, ExpiryDate, Period As String
StartMonth = Format(Month(StartDate), "00")
StartDay = Format(Day(StartDate), "00")
StartYear = Format(Year(StartDate), "00")


EndMonth = Format(Month(EndDate), "00")
EndDay = Format(Day(EndDate), "00")
EndYear = Format(Year(EndDate), "00")
    ExpiryDate = Worksheets("Parameters").Range("D7")
    Period = Worksheets("Parameters").Range("D8")
Symbol = Worksheets("Parameters").Range("D9")
qurl = "URL;http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/getFOHistoricalData.jsp?underlying=" + stockTicker + "&instrument=" + Symbol + "&expiry=" + ExpiryDate + "&type=-&strike=-&fromDate=&toDate=&datePeriod=" & Period & "&fileDnld=undefined"


'MsgBox qurl
On Error GoTo ErrorHandler:
With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "20"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
ErrorHandler:


End Sub


Sub DownloadFuturesData()
Dim frequency As String
Dim numRows As Integer
Dim lastRow As Integer
Dim stockTicker As String


Application.ScreenUpdating = False


lastRow = 42 'ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")


'Delete all sheets apart from Parameters sheet
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> "Parameters" Then ws.Delete
Next
Application.DisplayAlerts = True


'Loop through all tickers
For ticker = 11 To lastRow


    stockTicker = Worksheets("Parameters").Range("A" & ticker)
    ExpiryDate = Worksheets("Parameters").Range("D7")
    Period = Worksheets("Parameters").Range("D8")
    Symbol = Worksheets("Parameters").Range("D9")


    If stockTicker = "" Then
        GoTo NextIteration
    End If


    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = stockTicker


    Cells(1, 1) = "Stock Quotes for " & stockTicker
    Call DownloadStockFuturesQuotes(stockTicker, Worksheets("Parameters").Range("$b$5"), Worksheets("Parameters").Range("$b$6"), "$a$2", frequency)
    Columns("a:a").TextToColumns Destination:=Range("a1"), 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), Array(5, 1), Array(6, 1), Array(7, 1))
    Sheets(stockTicker).Columns("A:I").AutoFit


    lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
    If lastRow < 3 Then
        Application.DisplayAlerts = False
        Sheets(stockTicker).Delete
        GoTo NextIteration
        Application.DisplayAlerts = True
    End If


    Sheets(stockTicker).Sort.SortFields.Add Key:=Range("A10:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets(stockTicker).Sort
        .SetRange Range("A10:I" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


NextIteration:
Next ticker


If Sheets("Parameters").Range("exportToCSV") Then
    On Error GoTo ErrorHandler:
    Call CopyToCSV
End If


ErrorHandler:


Worksheets("Parameters").Select
Application.ScreenUpdating = True


End Sub
 
 Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal StartDate As Date, ByVal EndDate As Date, ByVal DestinationCell As String, ByVal freq As String)
Application.ScreenUpdating = False


Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear, Period As String
StartMonth = Month(StartDate)
    If StartMonth = 1 Then StartMonth = "Jan"
    If StartMonth = 2 Then StartMonth = "Feb"
    If StartMonth = 3 Then StartMonth = "Mar"
    If StartMonth = 4 Then StartMonth = "Apr"
    If StartMonth = 5 Then StartMonth = "May"
    If StartMonth = 6 Then StartMonth = "Jun"
    If StartMonth = 7 Then StartMonth = "Jul"
    If StartMonth = 8 Then StartMonth = "Aug"
    If StartMonth = 9 Then StartMonth = "Sep"
    If StartMonth = 10 Then StartMonth = "Oct"
    If StartMonth = 11 Then StartMonth = "Nov"
    If StartMonth = 12 Then StartMonth = "Dec"
StartDay = Day(StartDate)
StartYear = Year(StartDate)
StartD = StartDay & "-" & StartMonth & "-" & StartYear


EndMonth = Month(EndDate)
    If EndMonth = 1 Then EndMonth = "Jan"
    If EndMonth = 2 Then EndMonth = "Feb"
    If EndMonth = 3 Then EndMonth = "Mar"
    If EndMonth = 4 Then EndMonth = "Apr"
    If EndMonth = 5 Then EndMonth = "May"
    If EndMonth = 6 Then EndMonth = "Jun"
    If EndMonth = 7 Then EndMonth = "Jul"
    If EndMonth = 8 Then EndMonth = "Aug"
    If EndMonth = 9 Then EndMonth = "Sep"
    If EndMonth = 10 Then EndMonth = "Oct"
    If EndMonth = 11 Then EndMonth = "Nov"
    If EndMonth = 12 Then EndMonth = "Dec"
EndDay = Day(EndDate)
EndYear = Year(EndDate)
EndD = EndDay & "-" & EndMonth & "-" & EndYear


qurl = "URL;http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/getHistoricalData.jsp?symbol=" & stockTicker & "&series=EQ&""&fromDate=" & StartD & "&toDate=" & EndD & "&datePeriod=unselected&hiddDwnld=true"""
On Error GoTo ErrorHandler:
    With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        '    .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        '    .RefreshPeriod = 0
        '    .WebSelectionType = xlSpecifiedTables
        '    .WebFormatting = xlWebFormattingNone
        '    .WebTables = "20"
        '    .WebPreFormattedTextToColumns = True
        '    .WebConsecutiveDelimitersAsOne = True
        '    .WebSingleBlockTextImport = False
        '    .WebDisableDateRecognition = False
        '    .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
ErrorHandler:


End Sub
'http://www.nseindia.com/products/dynaContent/common/productsSymbolMapping.jsp?symbol=TATASTEEL&segmentLink=3&symbolCount=1&series=EQ&dateRange=3month&fromDate=&toDate=&dataType=PRICEVOLUMEDELIVERABLE
'http://www.nseindia.com/products/dynaContent/common/productsSymbolMapping.jsp?symbol=TATASTEEL&segmentLink=3&symbolCount=1&series=EQ&dateRange=+&fromDate=01-01-2012&toDate=16-04-2012&dataType=PRICEVOLUME




Sub DownloadData()
Dim frequency As String
Dim numRows As Integer
Dim lastRow As Integer
Dim stockTicker As String


Application.ScreenUpdating = False


lastRow = 42
frequency = Worksheets("Parameters").Range("b7")


'Delete all sheets apart from Parameters sheet
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> "Parameters" Then ws.Delete
Next
Application.DisplayAlerts = True


'Loop through all tickers
For ticker = 11 To lastRow


    stockTicker = Worksheets("Parameters").Range("$a$" & ticker)


    If stockTicker = "" Then
        GoTo NextIteration
    End If


    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = stockTicker


    Cells(1, 1) = "Stock Quotes for " & stockTicker
    Call DownloadStockQuotes(stockTicker, Worksheets("Parameters").Range("$b$5"), Worksheets("Parameters").Range("$b$6"), "$a$2", frequency)
    'Sheets(stockTicker).Columns("A:H").AutoFit


Selection.TextToColumns Destination:=Range("A1"), 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), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), _
Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), _
Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), _
Array(26, 1), Array(27, 1), Array(28, 1) _
), _
TrailingMinusNumbers:=True
    lastRow = Sheets(stockTicker).UsedRange.Row - 1 + Sheets(stockTicker).UsedRange.Rows.Count
    If lastRow < 3 Then
        Application.DisplayAlerts = False
        Sheets(stockTicker).Delete
        GoTo NextIteration
        Application.DisplayAlerts = True
    End If


    Sheets(stockTicker).Sort.SortFields.Add Key:=Range("A3:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets(stockTicker).Sort
        .SetRange Range("A2:H" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Rows("2:9").Insert


NextIteration:
Next ticker


If Sheets("Parameters").Range("exportToCSV") Then
    On Error GoTo ErrorHandler:
    Call CopyToCSV
End If


ErrorHandler:


Worksheets("Parameters").Select
Application.ScreenUpdating = True


End Sub

and my output is as

1373.30","1,371.25","1,86,905","2,577.15":"14-Oct-2015","ACC","EQ","1,352.00","1,378.00","1,351.90"," 1375.60","1,376.25","2,33,626","3,204.40":"13-Oct-2015","ACC","EQ","1,344.35","1,358.00","1,343.00"," 1353.00","1,352.20","2,25,640","3,048.52":"12-Oct-2015","ACC","EQ","1,350.00","1,359.95","1,340.60"," 1347.00","1,344.35","2,09,228","2,824.07":"09-Oct-2015","ACC","EQ","1,363.20","1,384.80","1,342.00"," 1343.55","1,347.35","2,00,403","2,715.66":"08-Oct-2015","ACC","EQ","1,354.00","1,361.50","1,345.00"," 1354.05","1,356.20","2,06,389","2,797.07":"07-Oct-2015","ACC","EQ","1,353.50","1,357.00","1,329.20"," 1351.10","1,352.25","2,49,008","3,356.72":"06-Oct-2015","ACC","EQ","1,377.00","1,380.00","1,343.00"," 1348.00","1,350.40","2,86,057","3,887.56":"05-Oct-2015","ACC","EQ","1,372.20","1,378.00","1,362.10"," 1368.00","1,369.70","1,76,688","2,421.38":"01-Oct-2015","ACC","EQ","1,354.50","1,375.00","1,352.00"," 1362.25","1,363.10","1,45,294","1,980.99":"30-Sep-2015","ACC","EQ","1,340.00","1,355.00","1,324.65"," 1352.00","1,346.75","2,00,741","2,685.57":"29-Sep-2015","ACC","EQ","1,325.00","1,344.95","1,301.50"," 1325.00","1,327.45","2,88,628","3,807.26":"28-Sep-2015","ACC","EQ","1,343.50","1,356.60","1,333.50"," 1335.00","1,336.75","1,58,638","2,131.23":"24-Sep-2015","ACC","EQ","1,343.10","1,371.50","1,325.00"," 1344.00","1,343.05","3,71,995","4,976.87":"23-Sep-2015","ACC","EQ","1,335.00","1,355.70","1,328.30"," 1343.00","1,345.65","1,72,544","2,320.80":"22-Sep-2015","ACC","EQ","1,389.00","1,397.00","1,340.35"," 1345.00","1,353.55","2,09,919","2,893.23":"21-Sep-2015","ACC","EQ","1,364.45","1,390.00","1,358.15"," 1385.00","1,383.40","1,31,026","1,805.70":"18-Sep-2015","ACC","EQ","1,386.00","1,408.00","1,366.10"," 1369.00","1,375.20","3,05,427","4,235.65":"16-Sep-2015","ACC","EQ","1,385.00","1,398.60","1,373.25"," 1373.25","1,377.30","1,15,756","1,598.73":"15-Sep-2015","ACC","EQ","1,385.00","1,392.60","1,371.70"," 1379.50","1,381.30","87,764","1,210.27":"14-Sep-2015","ACC","EQ","1,367.50","1,397.95","1,365.00"," 1387.50","1,388.65","1,32,692","1,840.34":"11-Sep-2015","ACC","EQ","1,381.00","1,394.70","1,360.00"," 1364.00","1,366.55","1,28,412","1,769.26":"10-Sep-2015","ACC","EQ","1,367.25","1,385.00","1,346.10"," 1370.30","1,378.90","1,82,385","2,493.06":"09-Sep-2015","ACC","EQ","1,360.00","1,385.60","1,354.00"," 1381.00","1,380.05","3,49,250","4,806.59":"08-Sep-2015","ACC","EQ","1,348.00","1,354.25","1,330.00"," 1346.05","1,345.80","2,29,191","3,078.92":"07-Sep-2015","ACC","EQ","1,359.90","1,359.90","1,333.40"," 1348.00","1,344.95","1,16,480","1,569.39":"04-Sep-2015","ACC","EQ","1,394.55","1,398.85","1,333.20"," 1353.80","1,345.40","4,13,021","5,571.47":"03-Sep-2015","ACC","EQ","1,361.10","1,398.60","1,361.10"," 1396.00","1,394.55","3,01,479","4,195.93":"02-Sep-2015","ACC","EQ","1,349.80","1,368.50","1,338.15"," 1354.00","1,356.35","3,27,607","4,442.26":"01-Sep-2015","ACC","EQ","1,321.00","1,343.90","1,317.15"," 1341.85","1,332.20","3,58,306","4,753.02":"31-Aug-2015","ACC","EQ","1,362.80","1,365.00","1,326.85"," 1333.30","1,334.85","4,23,911","5,680.85":"28-Aug-2015","ACC","EQ","1,387.90","1,387.90","1,358.00"," 1373.00","1,362.80","2,11,377","2,903.43":"27-Aug-2015","ACC","EQ","1,370.40","1,385.00","1,324.25"," 1370.30","1,369.95","6,92,610","9,406.73":"26-Aug-2015","ACC","EQ","1,362.15","1,382.70","1,352.05"," 1361.00","1,360.40","3,45,303","4,697.95":"25-Aug-2015","ACC","EQ","1,376.00","1,394.70","1,320.00"," 1374.70","1,362.10","5,24,563","7,097.78":"24-Aug-2015","ACC","EQ","1,375.00","1,384.00","1,355.00"," 1371.75","1,367.15","4,59,552","6,290.50":"21-Aug-2015","ACC","EQ","1,405.00","1,423.00","1,380.40"," 1399.55","1,406.45","2,42,739","3,395.42":"20-Aug-2015","ACC","EQ","1,440.10","1,442.45","1,407.05"," 1415.00","1,411.00","3,28,668","4,670.76":"19-Aug-2015","ACC","EQ","1,393.00","1,454.35","1,390.00"," 1445.00","1,446.90","4,62,171","6,603.44":"18-Aug-2015","ACC","EQ","1,370.20","1,393.50","1,369.00"," 1390.40","1,387.35","1,44,083","1,995.18":"17-Aug-2015","ACC","EQ","1,378.00","1,384.90","1,362.00"," 1363.85","1,367.35","2,39,277","3,279.19":"14-Aug-2015","ACC","EQ","1,367.00","1,385.90","1,365.00"," 1371.05","1,372.05","2,55,529","3,519.93":"13-Aug-2015","ACC","EQ","1,370.00","1,378.80","1,355.05"," 1361.05","1,364.55","3,56,482","4,873.49":"12-Aug-2015","ACC","EQ","1,370.00","1,373.65","1,356.00"," 1367.00","1,366.00","3,99,840","5,452.19":"11-Aug-2015","ACC","EQ","1,384.90","1,385.35","1,361.00"," 1375.00","1,374.25","2,62,562","3,597.01":"10-Aug-2015","ACC","EQ","1,398.00","1,408.95","1,375.20"," 1379.00","1,385.75","2,19,256","3,053.08":"07-Aug-2015","ACC","EQ","1,407.90","1,413.55","1,392.25"," 1393.20","1,399.65","2,79,113","3,918.50":"06-Aug-2015","ACC","EQ","1,382.00","1,417.00","1,379.70"," 1400.00","1,405.35","2,71,320","3,814.05":"05-Aug-2015","ACC","EQ","1,380.00","1,398.00","1,376.00"," 1385.00","1,381.75","2,05,261","2,840.09":"04-Aug-2015","ACC","EQ","1,403.70","1,403.70","1,366.00"," 1375.00","1,377.20","2,09,105","2,887.25":"03-Aug-2015","ACC","EQ","1,384.80","1,405.95","1,376.10"," 1388.50","1,391.60","3,41,258","4,754.82":

<tbody>
</tbody>


DateSymbolSeriesOpen PriceHigh PriceLow PriceLast Traded PriceClose PriceTotal Traded QuantityTurnover (in Lakhs)
01-Apr-2016ACCEQ1,371.251,417.001,371.25 1414.001,413.803,53,0304,937.08
01-Aug-2016ACCEQ1,695.551,703.501,674.00 1687.501,688.851,64,0062,772.27
01-Dec-2015ACCEQ1,349.001,364.251,347.15 1358.001,357.901,46,5761,992.58
01-Dec-2016ACCEQ1,349.101,354.901,327.00 1335.001,338.002,31,4483,093.20
01-Feb-2016ACCEQ1,245.001,278.901,240.30 1269.151,271.852,10,9582,674.48
01-Jan-2016ACCEQ1,362.001,380.401,360.00 1370.551,373.651,61,9822,223.92
01-Jul-2016ACCEQ1,618.351,626.051,611.75 1619.551,617.401,89,8543,076.78
01-Jun-2016ACCEQ1,535.001,559.951,528.00 1559.001,552.407,41,82611,439.49
01-Mar-2016ACCEQ1,199.001,243.351,195.00 1232.651,232.901,50,7471,836.43

<tbody>
</tbody>


table is not showing excel ...

showing something like this < tbody > < th > Date <

<tbody>
</tbody>


<tbody>
</tbody>
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
I copied your posted data to cell A1, (adjusted row height and formatting back to sheet norm), deleted all the characters preceding the first : (colon), then did a text to column using : (colon) as the delimiter, copied the row (ctrl + shift + right arrow) then copied the selection (ctrl + c) selected A2 and did a paste special transpose.

Selected all the new transposed column and find - replace " (quote) with nothing, find - replace , (comma) with space, text to columns with a space as the delimiter and got the data in the desired format as you show.

Howard
 
Upvote 0
i have to do it separately or any changes in vba code to be made??:confused: sir,

thanks for your kind reply
 
Upvote 0
The manual steps I took brought the data to the same format as you show, 10 columns wide, but without headers. A code to do the manual steps and applying Headers seems like a fairly simple solution.

Howard
 
Upvote 0

Forum statistics

Threads
1,214,817
Messages
6,121,720
Members
449,050
Latest member
MiguekHeka

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