Here is the code(for future reference is there a way to put this in a code
block on this message board??):
Sub URL_Get_Query()
' Select cell A2, *first line of data*.
Range("A1").Select
' Set Do loop to stop when an empty cell is reached.
Dim ProdNum As String
Dim CurCol As Integer
Dim CurRow As Integer
Dim CurCell As String
CurCol = 1
CurRow = 1
Do Until IsEmpty(ActiveCell)
ProdNum = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
With
ActiveSheet.QueryTables.Add(Connection:="URL;
http://www.ggna.corp.dom/Applications/tbench/tbnew/xsql/tbench_g_imf_1.xsql?ITEM="
& ProdNum, Destination:=ActiveCell)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,6,9,10"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range(Cells(19, CurCol + 1), Cells(19, CurCol + 1)).Select
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"" "",RC[2])"
ActiveCell.Offset(1, 1).Select
Loop
Range(Cells(1, CurCol), Cells(35, CurCol)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range(Cells(2, CurCol + 1), Cells(500, CurCol + 3)).Select
Selection.Delete Shift:=xlToLeft
' Step over and up 1 row from present location.
CurRow = CurRow + 1
CurCol = CurCol + 1
Range(Cells(1, CurCol), Cells(1, CurCol)).Select
Loop
End Sub