Import, Find End of Used Range, Offset or Move Down 1 Row, Continu

[ryguy7272]

Once again, I find myself mired in VBA loops. The macro below works pretty
well, and basically does the import task that I need it to do, but instead of
finding the end of the used range (which varies each time the loop is rerun,
based on the number of items imported), it always goes back to A3 (please see
code below). As it is now, the macro basically imports data, then inserts
columns, and then shifts everything to the right. I am guessing this
requires some kind of OFFSET function, or something of that nature. What I
really want this to do is import data, find end of the used range, shift down
one row, and then start the next import of data at that point…shifted down
one row. Ultimately I want to do a lookup on all stock symbols, which
(ideally) should end up in ColumnA. Is there anyone out there who can offer
some guidance? If I don’t get this working properly, I suppose I can
copy/paste this data into Excel, but I want to learn a more efficient way of
doing this for this task and for future reference.

Sub Import()

Range("A3").Activate
For Each c In Sheets("Import Stock Symbols").Range("Z3:Z28") ‘Just a way
of storing letters A-Z off the screen

str1 = "URL;http://www.dbc.com/cgi-bin/htx.exe/SYMBOLS/" & _
c.Value & _
"STOCK.html?SOURCE=CORE/DBC"
With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A3"))

.Name = str1

.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 = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next c

End Sub


Thanks!!!

 

[JLGWhiz]

It is going to "A3" because that is where the code tells it to go.

,Destination:=Range("A3"))

You need to establish the lastRow variable with

lstRw = Cells(Rows.Count, 1).End(xlUP).Row

Insert that line after Range("A3").Activate
Then make your destination

Destination:= Range("A" & lstRw + 2)

Which will start on the second row after the last used row in column A.
This leaves one empty row in between downloads. If you don't want the empty
row,
change the + 2 to + 1.

 

[JLGWhiz]

Sorry, you need to add the lstRw = line after your For Each statement so that
it will recalculate on each refresh. This might cause your first iteration
to post lower than Range("A3").

 

[ryguy7272]

Awesome! This is exactly what I'm looking for JLGWhiz!! Thanks so much!!!

'Final version of the code is listed directly below...
Sub Import()

Application.ScreenUpdating = False

Range("A3").Activate

For Each c In Sheets("Import Stock Symbols").Range("Z3:Z28")
‘The Range, Z3:Z28 contains the letters of the alphabet, A-Z
‘The loop runs through each of the 26 items in Z3:Z28;
‘each item is assigned to the variable
“c.Valueâ€
lstRw = Cells(Rows.Count, 1).End(xlUp).Row

str1 = "URL;http://www.dbc.com/cgi-bin/htx.exe/SYMBOLS/" & _
c.Value & _
"STOCK.html?SOURCE=CORE/DBC"
With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A" & lstRw + 1))

.Name = str1

.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 = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next c

Columns("A:A").ColumnWidth = 30
Range("A1").Select

Application.ScreenUpdating = True


End Sub