I am new and have searched endlessly for a couple of days to try and figure this out. Thanks in advance for any help and insight...
sheets(1) has two columns; Column A is href links and Column B is FileNo
Macro looks up href links on sheets(1) and utilizes a webquery to pull table information off of href link in sheets(1) and puts data in Sheets(3). The table is constant and will always have columns (A:I) but the rows are dynamic from 4 rows to 100’s of rows…
Using Sheets(3).Range(“A1”).CurrentRegion the table is copied from Sheets(3) to Sheets(2) in Column B
Next, I would like to look up the FileNo in Sheets(1) that corresponds to the Href. Then copy and paste with filldown into Sheets(2) Column A
Essentially the FileNo acts as a unique key for all the data pulled from each Href webquery.
There are multiple Hrefs (4k plus).
The code works and I can get a single FileNo associated correctly on one line of href table data but I can’t filldown dynamically in Sheets(2) Column A
I am using windows7 and excel2010 32bit
Sub Macro2()
a = 1
Sheets(3).Select
While Sheets(1).Cells(a, 1) <> ""
urladdress = "URL;" & Sheets(1).Cells(a, 1).Text
With ActiveSheet.QueryTables.Add(Connection:= _
urladdress, Destination:=Range("A1"))
.Name = Right(Sheets(1).Cells(a, 1).Value, 42)
.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
Dim CopyRange, PasteRange, FileRange As Range
Dim LastRow As Integer
Set CopyRange = Sheets(3).Range("A1").CurrentRegion
Set PasteRange = Sheets(2).Range("B65536").End(xlUp)
CopyRange.Copy PasteRange
LastRow = Sheets(2).Cells(Sheets(2).Rows.Count, "B").End(xlUp).Row
Set FileRange = Range(PasteRange.Address & ":" & "B" & Lastrow).Offset(0, -1)
Sheets(1).Cells(a, 2).Copy Destination:=FileRange
Sheets(3).Cells.ClearContents
a = a + 1
Wend
End Sub
Last edited:
