I am planning to extract data from a table on the web. The code below was mostly from built-in web scraping function in Excel.
What I want is to find the last row with data and print on the first blank row.
Sub Sub1()
ActiveSheet.Cells.Clear
Dim lastRow As Long
Dim i As Integer
For i = 1 To 2
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.aastocks.com/tc/stocks/quote/symbolsearch.aspx?page=" & i & " &order=symbol&seq=asc", Destination _
:=Range("A,lastRow")) '???? I got an error here, what I want is to detect the last row and print on the first blank row.???
'.CommandType = 0
.Name = "symbolsearch_1"
.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 = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Debug.Print lastRow
Next i
End Sub
This seems to work ok now. You were close, you should be able to edit as required.
Sub Sub1()
ActiveSheet.Cells.Clear
Dim lastRow As Long
Dim i As Integer
Dim sTicker As String
'set the first row to write to
lastRow = 2
For i = 1 To 2
sTicker = InputBox("Enter the code to search for")
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.aastocks.com/tc/stocks/quote/symbolsearch.aspx?page=" & sTicker & " &order=symbol&seq=asc", Destination _
:=Range("A" & lastRow)) 'uses the ticker value entered and fixed the destination part
'.CommandType = 0
.Name = "symbolsearch_1"
.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 = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Next i
End Sub
Related
I searched the internet, but I could not find anywhere a dynamic query from links in cells.
In excel i have webquery which generate this data:
I have data in excel Sheet("CustomReport"):
SalesOrder Value1 Value2 Value3 Links
1 Jonas Station1 8 https://x.com=1
2 Greg Station1 5 https://x.com=2
3 Anton Station1 1 https://x.com=3
... ... ... ... ...
Number of rows in this query is always different when it is refreshed.
And based on this webquery i need generate dynamic webquery in macro.
For example:
DynamicQuery1 save data from report https://x.com=1 to Sheet name "Orders" started from A1 and ending A{X} value (reports have diffrents number of rows).
DynamicQuery2 save data from report https://x.com=2 to the same Sheet "Orders" but started from A{X+1}.
I have such a macro, but it only works for the first row.
Sub Test()
Dim URL As String
URL = Sheets("CustomReport").Range("E2").Value
Sheets("Orders").Select
With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=Range("$A$1"))
.Name = "team2289_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
And i need refreshing this macro every 1 hour.
Anyone can give me macro based on this way?
To loop through the cells use:
dim c as range, DataSpot as range
set c = Sheets("CustomReport").Range("E2")
while c.value <>""
url = c.value
set DataSpot=cells(sheets("orders").Range("A1").SpecialCells(xlLastCell).row+1,1)
' Web Query Code goes here
set c=c.offset(1,0)
wend
In your data query, use:
Destination:=Range(DataSpot.Address))
Sub Test()
Dim URL As String
URL = Sheets("CustomReport").Range("E2").Value
Sheets("Sheet1").Select
Dim c As Range, DataSpot As Range
Set c = Sheets("CustomReport").Range("E2")
While c.Value <> ""
Set DataSpot = Cells(Sheets("Sorders").Range("A1").SpecialCells(xlLastCell).Row + 1, 1)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=Range(DataSpot.Address))
.Name = "team2289_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Set r = r.Offset(1, 0)
Wend
End Sub
i put your code and i have debug with:
Set r = r.Offset(1, 0)
What wrong i do ?
I need to basically fill two cells in each row with data from the respective URL present in the same row. When the query is made using macro it returns 5 pieces of data out of which I need only two.
I recorded two macros(one to query the page and other to adjust the data pieces i get) and combined them and applied a do while loop.
But it is returning an error in this line - myurl = "URL;" & Tabsheet.Cells(i, 6)
Below is the code:
'
' Macro1 Macro
'
Sheets("Tabsheet").Select
Range("A1").Select
Dim i As Integer, myurl As String
i = 1
Do While i < 102
myurl = "URL;" & Tabsheet.Cells(i, 6)
With ActiveSheet.QueryTables.Add(Connection:= _
myurl, Destination:=ActiveCell.Offset(i, 8))
.Name = "Query" & i
.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 = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("H105").Select
Selection.Cut
Range("I104").Select
Selection.Cut
Range("I103").Select
Selection.ClearContents
Range("H102").Select
i = i + 1
Loop
End Sub
Any suggestions will be extremely helpful.
This should work :
myurl = CStr("URL;" & Sheets("Tabsheet").Cells(i, 6))
You can use TabSheet directly as you didn't set it as an object, you could have if you did that before :
Dim TabSheet As Worksheet
Set TabSheet = ThisWorkbook.Sheets("TabSheet")
'------------------------------------
'--------Here come your code---------
'------------------------------------
'And when it's done, don't forget to free what you have set
Set TabSheet = Nothing
I have this VBA script that works:
Sub Basic_Web_Query()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & ActiveSheet.Range("A2").Value, Destination:=Range("E2"))
.Name = "q?s=goog_2"
.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 = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
I want the macro to do this in a loop, i.e. go to A3 with destination E3, A4 with destination A4... etc.
any help will be appreciated
thansk!
I like to use 'offset' for these loops: OFFSET(rows down, columns right).
Negative values move up and left.
for example:
for p= 1 to 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & ActiveSheet.Range("A2").offset(p-1,0).Value, Destination:=Range("E2").offset(p-1,0))
'other code
End With
next p
google 'loop vba' and you will hit plenty of examples. Here's one:
Dim rw As Long
For rw = 1 To 5
Range("E" & rw).Value = Range("A" & rw).Value
'other stuff
Next rw
I would like to download the daily prices of our stock exchange using the following code in vba. Although the code works i cant seem to be able to get the sheets renamed to the corresponding day when the price list was obtained.
Dim DownloadDay As Date
DownloadDay = #3/4/2014#
Do While DownloadDay < #4/4/2014#
ActiveWorkbook.Worksheets.Add
Call website(Format(DownloadDay, "YYYYMMDD"))
'INCREMENT THE DAY
Sheets.Add.Name = "DownloadDay"
DownloadDay = DownloadDay + 1
Loop
End Sub
Sub website(sDate As String)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://live.mystocks.co.ke/price_list/" & DownloadDay & "/", Destination:=Range("$A$1"))
.Name = DownloadDay
'To rename each work sheet with the corresponding day'
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
This line of VBA will set the name of your worksheet:
Sheets("Sheet2").Name = "NewName"
You can not use "/" the character in the name though, and the variable is set to a date not a string.
Try this.
.name = CSTR(FORMAT(DownloadDay,"YYYYMMMDD"))
I am trying to scrape a large volume of data using my rather basic excel skills. I am using this as a guide (http://www.familycomputerclub.com/scrpae-pull-data-from-websites-into-excel.html), and have got it to work for my data, but now trying to amend the code to meet my requirements.
I have about 10,000 Roll numbers listed in columns, and need to scrape the data from this site (last 10 digits being the roll numbers): http://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber=2011016000
Basically, rather than adding new worksheets for each page download (as per the guide I have been using above), I would like to keep all the new data on the master page, simply transposing the it in to the row with its corresponding roll number (perhaps from the C column).
My code is as follows:
Sub adds()
For x = 1 To 5
Worksheets("RollNo").Select
Worksheets("RollNo").Activate
mystr = "URL;http://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber=2000416000.html"
mystr = Cells(x, 1)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'CommandType = 0
.Name = "2000416000_1"
.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 = "2,6,7" '---> Note: many tables have been selected for import from the website
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub
Sub ProcessAll()
Dim c As Range, shtData As Worksheet
Set shtData = Worksheets("WebQuery")
For Each c In Worksheets("RollNo").Range("A1:A5").Cells
If c.Value <> "" Then
FetchData c.Value
'move fetched data to the sheet
With c.EntireRow
.Cells(2).Value = shtData.Range("A2").Value
'etc....
End With
End If
Next c
End Sub
Sub FetchData(rollNo)
Const BASE_URL As String = "URL;http://www.winnipegassessment.com/AsmtPub/english/" & _
"propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber="
Dim qt As QueryTable
With Worksheets("WebQuery")
On Error Resume Next
.QueryTables(1).Delete
On Error GoTo 0
.Cells.Clear
With .QueryTables.Add(Connection:=BASE_URL & rollNo, Destination:=.Range("A2"))
.Name = "2000416000_1"
.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 = "2,6,7"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End With
End Sub