Hi,

With great hopes I'm posting my question here. I hope, wish and pray that someone should be able to help me with this problem.

What I’ve to do daily is to go out local webpage and check the prices for many items.
What I do is, I open a page, check the price and then go to another webpage, check the price and so on...

(The links appears like this):
Link1: http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/abc1
Link2: http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/abc2
Link3. http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/abc3

Complete link will be same except the Item code. (Where Item Codes are abc1, abc2, abc3…)

It is taking a lot of time for me to open each page and check the prices.

So for that I wrote a small macro in excel 2007 to pull up the information from webpage. I just put the item code in Sheet1 Cell A1 and run macro… for example Cell A1 = abc1

It will then connect to that webpage and pull up the information to the Sheet2. Then I use vlook and pull the price in sheet1.

The problem I'm facing is, I have to check about 50 item’s prices. That means I have to run the macro about 50 times per day :confused:

What I'm looking for is, I want to paste all the codes in Column A in Sheet1 and run a macro and the macro should connect to webpage and content of the webpage should be imported to Sheet2 and using Vlookup the price should be pulled in sheet1. And the outcome should be… for Item number which is in A1, it should pull up the price in B1 (Using Vlookup). Then it should paste special the only the value (price) in B1 (Because, when the macro run again, it should clear all the content in Sheet2). Then again For Item number in A2, it should pull up the price in Cell B2 (using vlookup) and Paste Special the value in B2 and clear the content of sheet2. Then again A3……..

This code is not serving my purpose because I have to paste the item codes and run the macro about 50-60 times. Please help me with this, I'm facing so many problems because of this. I'm really in need of such macro code.


Something like this:



| A B C D E

----------------------------------------------------------------------

1 | CODES Old Price New Price You Save Discount

2 | abc1 $1000 $500 $500 50%

3 | abc2 $800 $600 $200 20%

4 | abc3

5 | abc4



Below is the code I use:

================================================== ========

Sub main macro()
Dim url1 As Long


Range("A6").Value = " http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/” & Range("a1")

Call Connect_Page
Call Find_Sub
End Sub


Sub Connect_Page()
Dim url1 As String

Range("A6").Select
Range("a6").Copy
url1 = Range("a6")
'MsgBox (url1)

Range("A7").Select

With ActiveSheet.QueryTables.Add(Connection:="URL;" & url1, _
Destination:=Range("$A$7"))
.Name = "myurl"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Sheets("sheet2").Select
Range("a2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,Sheet1!C7:C9,3,0)"
Range("b2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,Sheet1!C7:C9,3,0)"
Range("c2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,Sheet1!C7:C9,3,0)"
Range("d2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,Sheet1!C7:C9,3,0)"

End Sub

Sub Find_Sub()
Dim rngFound As Range
Dim sAddr As String, rw As Long
Dim sCount As Long
sCount = 0
With Worksheets("Sheet1")
Set rngFound = .Cells.Find(What:="Subtract", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngFound Is Nothing Then
sAddr = rngFound.Address
rw = 1

Do
rngFound.Copy _
Sheets("Sheet2").Cells(5, rw)
rw = rw + 1
Set rngFound = .Cells.FindNext(rngFound)
sCount = sCount + 1
Loop While rngFound.Address <> sAddr
MsgBox sCount & " rows copied", vbInformation, "Transfer Done"
Else
' MsgBox "No Downcells."
Sheets("
Sheets(").Select

Range("e2").Select

Range("No Downcells Found").Value = "Sheet2"
End If
End With
Sheets("B3").Select
End Sub

================================================== ========

Pleaseeeeeeeeeeeeeeee help me!!

You can also contact me directly at [email protected]

Thanks in Adv.

Regards,
Sirajuddin

put it in a loop.


Seeing that you created that macro you should be able to understand this..

this is your sub main


Dim url1 As Long

For X = 1 to 60
Range("B" & x).Value = " http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/” & Range("A" & X)

Call Connect_Page(X)
Call Find_Sub(X)

Next


you just need to pass the X into where its needed so set everything up so the col A has all the item codes...
then this will loop through each one. Then pass the X (row value) into the other subs, so they can put the info into the right spots.

Understand?

actually looking at your code, stuff would need to change to make this work better... I have started you off... because I don't know the page layout etc.. I can't do too much more. But the point is to pass in what's needed...


Sub main macro()
Dim url1 As Long

For X = 1 To 60
Connect_Page "http://www.xxxxxxxxxxxxxxxxxx.com/xxxx/xxx/" & Range("A" & X), X
Find_Sub()
Next

End Sub


Sub Connect_Page(URL As String, iRow As Integer)
Dim url1 As String

Range("B" & iRow).Select

With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=Range("B" & iRow))
.Name = "myurl"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
etc
etc
etc

Thanks a lot for the quick resolution...