One VBA question

[wxue]

Following coding connect to finance.yahoo.com and download data. But it has an error. Put C and F in A2, A3. you can see the error msg. Can anyone help me?

Sub createnewquery()
Dim WSD As Worksheet
Dim WSW As Worksheet
Dim QT As QueryTable
Dim FinalRow As Long
Dim i As Integer
Dim Connectstring As String
Dim FinalresultRow As Long
Dim Row As Long

Set WSD = Worksheets("Portfolio")
Set WSW = Worksheets("Workspace")

'Read column A of Portfolio to find all stock symbol
FinalRow = WSD.Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
Select Case i
Case 2
Connectstring = "URL;http//finance.yahoo.com/q/cq?d=v1&s=" & _
WSD.Cells(i, 1).Value
Case Else
Connectstring = Connectstring & ",+" & WSD.Cells(i, 1).Value
End Select
Next i

'On the workspace worksheet, clear all exitsting query table
For Each QT In WSW.QueryTables
QT.Delete
Next QT

'Define a new webquery
Set QT = WSW.QueryTables.Add(Connection:=Connectstring, Destination:=WSW.Range("A1"))
With QT
.Name = "portfolio"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With

'Refresh the query
QT.Refresh BackgroundQuery:=False

'define a name range for the result
FinalresultRow = WSW.Cells(65536, 1).End(xlUp).Row
WSW.Cells(1, 1).Resize(FinalresultRow, 7).Name = "Webinfo"

'Build a vlookup to get quote from WSW to WSD
RowCount = FinalRow - 1
WSD.Cells(2, 2).Resize(RowCount, 1).FormulaR1C1 = "vlookup(RC1,WebInfo,3,False)"
WSD.Cells(2, 3).Resize(RowCount, 1).FormulaR1C1 = "vlookup(RC1,WebInfo,4,False)"
WSD.Cells(2, 4).Resize(RowCount, 1).FormulaR1C1 = "vlookup(RC1,WebInfo,5,False)"
WSD.Cells(2, 5).Resize(RowCount, 1).FormulaR1C1 = "vlookup(RC1,WebInfo,6,False)"
WSD.Cells(2, 7).Resize(RowCount, 1).FormulaR1C1 = "vlookup(RC1,WebInfo,2,False)"

MsgBox "Data Updated"


End Sub

 

[xld]

You are missing the : from the ConnectString

                Connectstring = "URL;http://finance.yahoo.com/q/cq?d=v1&s=" & _

 

[wxue]

thanks

 

[hitesh78]

I have created some functions and created an excel addin(This addin is extracting data from other applications).

When ever I load the addin and define the formula it works fine , however when I unload the addin the formula that I have written gets converted and include the path where I had saved the addin.

for example :

Formula when addin is loaded : =QC_DEFECT(1111,,,,)
This works fine

When I unload the addin the formula gets converted to

='C:\Documents and Settings\shahhit\Application Data\Microsoft\AddIns\QC Report X.xla'!QC_DEFECT(1111,,,,)

This create a problem as , if I send the file to other users , they have to redefine the formula again as the old formula does not work as it includes the path from my PC.

 

[xld]

Don't unload the addin?

 

[wxue]

I checked with my code carefully. but it still has some problems. can anyone help me? Thanks. (Please put some stock in A2,A3,A4...e.g. GOOG, IBM, MSFT..)

-----------------


Sub createnewquery()
Dim WSD As Worksheet
Dim WSW As Worksheet
Dim QT As QueryTable
Dim FinalRow As Long
Dim i As Integer
Dim ConnectString As String
Dim FinalResultRow As Long
Dim RowCount As Long

Set WSD = Worksheets("Portfolio")
Set WSW = Worksheets("Workspace")

'Read column A of Portfolio to find all stock symbol
FinalRow = WSD.Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
Select Case i
Case 2
ConnectString = "URL;http://finance.yahoo.com/q/cq?d=v1&s=" & _
WSD.Cells(i, 1).Value
Case Else
ConnectString = ConnectString & ",+" & WSD.Cells(i, 1).Value
End Select
Next i

'On the workspace worksheet, clear all exitsting query table
For Each QT In WSW.QueryTables
QT.Delete
Next QT

'Define a new webquery
Set QT = WSW.QueryTables.Add(Connection:=ConnectString, _
Destination:=WSW.Range("A1"))
With QT
.Name = "portfolio"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With

'Refresh the query
QT.Refresh BackgroundQuery:=False

'define a name range for the result
FinalResultRow = WSW.Cells(65536, 1).End(xlUp).Row
WSW.Cells(1, 1).Resize(FinalResultRow, 7).Name = "WebInfo"

'Build a vlookup to get quote from WSW to WSD
RowCount = FinalRow - 1
WSD.Cells(2, 2).Resize(RowCount, 1).FormulaR1C1 = "=vlookup(RC1,WebInfo,3,False)"
WSD.Cells(2, 3).Resize(RowCount, 1).FormulaR1C1 = "=vlookup(RC1,WebInfo,4,False)"
WSD.Cells(2, 4).Resize(RowCount, 1).FormulaR1C1 = "=vlookup(RC1,WebInfo,5,False)"
WSD.Cells(2, 5).Resize(RowCount, 1).FormulaR1C1 = "=vlookup(RC1,WebInfo,6,False)"
WSD.Cells(2, 7).Resize(RowCount, 1).FormulaR1C1 = "=vlookup(RC1,WebInfo,2,False)"

MsgBox "Data Updated"


End Sub