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