![]() |
|
#26
|
||||
|
||||
|
Yep, each time you do a QueryTables.Add giving Dest:=Range("K1"), it bumps the columns that already existed to the right to make room for a new set of data. It turns out its doing that even the first time (I put some data in J2:M2 to be sure).
If you look at this page, you'll see a list of the properties of a QueryTable object. Let's take a look at each of the ones mentioned in your With group: .Name = Range("A4").Value — This is just a character string, and since you don't use it elsewhere you can probably omit this statement. .FieldNames = True — This is the default setting; no need to specify it. .RowNumbers = False — Probably best to leave this in. .FillAdjacentFormulas = False — "True if formulas to the right of the specified query table are automatically updated whenever the query table is refreshed." We could test this, but since you don't have any formulae to the right I would guess it's not important. .PreserveFormatting = True — Default value; omit. .RefreshOnFileOpen = False — The default; omit. .BackgroundQuery = True — You're overriding this value when you execute the Refresh, so omit it. .RefreshStyle = xlInsertDeleteCells — Ah, maybe this is why columns are inserted. I changed this to xlOverwriteCells instead, and it writes over the old range, which I take it you would prefer. .SavePassword = False — This is about ODBC connections, not Web queries; remove. .SaveData = True — Depends on whether you want to recreate these QueryTables every time you run the macro. You haven't gotten that far in your thinking, yet, I expect; later on you may want to set this to False. .AdjustColumnWidth = True — Default value (even though it doesn't seem to be doing it); remove. .RefreshPeriod = 0 — Probably the default value. .WebSelectionType = xlEntirePage — If I remember right, with this web site you need to get the entire page anyway, so leave it. .WebFormatting = xlWebFormattingNone — Seems appropriate. .WebPreFormattedTextToColumns = True — The default value. .WebConsecutiveDelimitersAsOne = True — The default value. .WebSingleBlockTextImport = False — The default value. .WebDisableDateRecognition = False — The default value. .WebDisableRedirections = False — The default value. That makes the Add a bit less unwieldy: Code:
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("K1"))
.RowNumbers = False
.RefreshStyle = xlOverwriteCells
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
End With
1) You've managed your loop like this: Code:
Dim X As Integer Dim Y As Integer X = Right(ActiveCell.Value, 2) Y = 1 Do Until X = Y 'blah, blah, blah Y = Y + 1 Loop Code:
For Y = 1 To Right(ActiveCell.Value, 2) 'blah, blah, blah Loop 2) You said to look at Right(ActiveCell.Value,2), and that's great when you have a 2-digit number of pages in a query. But if you only have 9, it'll fail. Do it this way instead: Code:
For Y = Mid(ActiveCell.Value, 2) 3) You would eventually have noticed this without my pointing it out: It turns out that &page=1 of the query is actually the second page, and &page=19 is the 20th; so your program has been doing the query once too many times. So in my code I'm running only up to Mid(ActiveCell.Value, 2) - 1. 4) You're changing the query target range each time you run the loop. I can't see that it hurts anything, but I can't see that it help either; so in my code I eliminated the check for the last row. 5) I got to thinking about all those Adds. Why create 20 different web queries that have to be stored in the worksheet? I experimented with just using the one over and over; I create the one at the beginning, and call that QueryTable object "qto". Then in the loop I change qto.Connection and refresh the table, and it seems to work: Code:
Set qto = ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("K1"))
With qto
.RowNumbers = False
.RefreshStyle = xlOverwriteCells
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
End With
.
.
.
For Y = 1 To Mid(ActiveCell.Value, 2) - 1
qto.Connection = "URL;" & Range("A3").Value & "&page=" & Y
qto.Refresh BackgroundQuery:=False
Next Y
Code:
Sub Test()
Sheets("Temp").Select
URL = "URL;" & Range("A3").Value
Set qto = ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("K1"))
With qto
.RowNumbers = False
.RefreshStyle = xlOverwriteCells
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
End With
Range("K1").Select
Cells.Find(What:="page:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="…", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
For Y = 1 To Mid(ActiveCell.Value, 2) - 1
qto.Connection = "URL;" & Range("A3").Value & "&page=" & Y
qto.Refresh BackgroundQuery:=False
Next Y
End Sub
I should proofread all this before I submit it, but I think I'll go to bed instead and hope I haven't made any embarrassing errors. |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Match two sets of data and display specific data | lolly150 | Excel | 1 | 05-14-2012 10:33 PM |
| Edit Data Source- Linking template charts to new data | lbf | PowerPoint | 0 | 10-28-2011 12:19 PM |
| Powerpoint: adding data to trend lines w/o data labels | HaiLe | PowerPoint | 0 | 04-11-2011 09:21 AM |