Private Sub ExtractData()
On Error GoTo ErrHandler
Dim i As Long
Dim b As Long
Dim RowType As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim CurrentTitle As String
Dim CurrentBrand As String
Dim CurrentSku As String
Dim CurrentAliasSku As String
Dim CurrentAsin As String
Dim CurrentError As String
Dim CurrentAsin2 As String
b = 1
For i = 1 To TotalRows
'Find out the type of row we are dealing with
If Worksheets(MainWorksheet).Cells(i, 1) = "Start URL" Then
RowType = "Start"
GoTo MoveNextLine
Else
If Worksheets(MainWorksheet).Cells(i, 1) = "BlueboxList" Then
RowType = "BlueboxList"
GoTo MoveNextLine
Else
If Worksheets(MainWorksheet).Cells(i, 1) = "SellerList" Then
RowType = "SellerList"
i = i + 1 'Skips the title line on the next row
GoTo MoveNextLine
End If
End If
End If
'Set the row number of the destination worksheet so that we can append data
b = b + 1
'Each different row type has a different load of rules to apply
Select Case RowType
Case Is = "Start"
CurrentTitle = Worksheets(MainWorksheet).Cells(i, 2)
CurrentBrand = Worksheets(MainWorksheet).Cells(i, 3)
CurrentSku = Worksheets(MainWorksheet).Cells(i, 6)
CurrentAliasSku = Worksheets(MainWorksheet).Cells(i, 7)
CurrentAsin = Worksheets(MainWorksheet).Cells(i, 8)
CurrentError = Worksheets(MainWorksheet).Cells(i, 12)
CurrentAsin2 = Worksheets(MainWorksheet).Cells(i, 13)
If CurrentError > "" Then CurrentError = "E"
Worksheets("Worksheet").Cells(b, 1) = CurrentTitle
Worksheets("Worksheet").Cells(b, 2) = CurrentBrand
Worksheets("Worksheet").Cells(b, 3) = "H"
Worksheets("Worksheet").Cells(b, 4) = Worksheets(MainWorksheet).Cells(i, 9) 'Seller
If Worksheets(MainWorksheet).Cells(i, 11) > "" Then 'Shipping
Worksheets("Worksheet").Cells(b, 5) = Worksheets(MainWorksheet).Cells(i, 11)
Else
Worksheets("Worksheet").Cells(b, 5) = Worksheets(MainWorksheet).Cells(i, 5)
End If
If Worksheets(MainWorksheet).Cells(i, 10) > "" Then 'Price
Worksheets("Worksheet").Cells(b, 6) = Worksheets(MainWorksheet).Cells(i, 10)
Else
Worksheets("Worksheet").Cells(b, 6) = Worksheets(MainWorksheet).Cells(i, 4)
End If
Worksheets("Worksheet").Cells(b, 7) = CurrentSku 'sku
Worksheets("Worksheet").Cells(b, 8) = CurrentAliasSku 'AliasSku
Worksheets("Worksheet").Cells(b, 9) = CurrentAsin 'asin
Worksheets("Worksheet").Cells(b, 13) = CurrentError
'If Amazon causes a redirect to another asin then we need to bring this to our attention
If CurrentAsin <> CurrentAsin2 Then
Worksheets("Worksheet").Cells(b, 13) = "R"
End If
Case Is = "BlueboxList"
Worksheets("Worksheet").Cells(b, 1) = CurrentTitle
Worksheets("Worksheet").Cells(b, 2) = CurrentBrand
Worksheets("Worksheet").Cells(b, 3) = "B"
Worksheets("Worksheet").Cells(b, 4) = Worksheets(MainWorksheet).Cells(i, 2)
Worksheets("Worksheet").Cells(b, 5) = Worksheets(MainWorksheet).Cells(i, 4)
Worksheets("Worksheet").Cells(b, 6) = Worksheets(MainWorksheet).Cells(i, 3)
Worksheets("Worksheet").Cells(b, 6) = Replace(Worksheets("Worksheet").Cells(b, 6), Worksheets("Worksheet").Cells(b, 5), "", 1, , vbTextCompare)
Worksheets("Worksheet").Cells(b, 7) = CurrentSku 'sku
Worksheets("Worksheet").Cells(b, 8) = CurrentAliasSku 'AliasSku
Worksheets("Worksheet").Cells(b, 9) = CurrentAsin 'asin
Case Is = "SellerList"
Worksheets("Worksheet").Cells(b, 1) = CurrentTitle
Worksheets("Worksheet").Cells(b, 2) = CurrentBrand
Worksheets("Worksheet").Cells(b, 3) = "S"
If Worksheets(MainWorksheet).Cells(i, 7) > "" Then 'seller
Worksheets("Worksheet").Cells(b, 4) = Worksheets(MainWorksheet).Cells(i, 7)
Else
Worksheets("Worksheet").Cells(b, 4) = Worksheets(MainWorksheet).Cells(i, 2)
End If
'If the merchant number is being used then extract the merchant number from the url
pos1 = InStr(1, Worksheets("Worksheet").Cells(b, 4), "http://www.amazon.co.uk/shops/", vbTextCompare)
If pos1 > 0 Then
Worksheets("Worksheet").Cells(b, 4) = Replace(Worksheets("Worksheet").Cells(b, 4), "http://www.amazon.co.uk/shops/", "", , , vbTextCompare)
'Find the position of the next "/"
pos1 = InStr(1, Worksheets("Worksheet").Cells(b, 4), "/", vbTextCompare)
If pos1 > 0 Then
Worksheets("Worksheet").Cells(b, 4) = Mid(Worksheets("Worksheet").Cells(b, 4), 1, pos1 - 1)
End If
End If
Worksheets("Worksheet").Cells(b, 5) = Worksheets(MainWorksheet).Cells(i, 4) 'shipping
Worksheets("Worksheet").Cells(b, 6) = Worksheets(MainWorksheet).Cells(i, 3) 'price
Worksheets("Worksheet").Cells(b, 7) = CurrentSku 'sku
Worksheets("Worksheet").Cells(b, 8) = CurrentAliasSku 'AliasSku
Worksheets("Worksheet").Cells(b, 9) = CurrentAsin 'asin
Worksheets("Worksheet").Cells(b, 10) = Worksheets(MainWorksheet).Cells(i, 2) 'Seller Image
'Flag Records which are subject to Amazon Prime - For statistics purposes only
pos1 = InStr(1, Worksheets("Worksheet").Cells(b, 10), "prime", vbTextCompare)
If pos1 > 0 Then
Worksheets("Worksheet").Cells(b, 16) = "Prime"
End If
If Worksheets("Worksheet").Cells(b, 10) = "http://ecx.images-amazon.com/images/I/01pSGAIMN3L.gif" Then
Worksheets("Worksheet").Cells(b, 4) = "Amazon"
End If
Worksheets("Worksheet").Cells(b, 11) = Worksheets(MainWorksheet).Cells(i, 5) 'Ratings
Worksheets("Worksheet").Cells(b, 12) = Worksheets(MainWorksheet).Cells(i, 6) 'Stock Note
End Select
Worksheets("Worksheet").Cells(b, 5) = CleanPricingFields("S", Worksheets("Worksheet").Cells(b, 5))
Worksheets("Worksheet").Cells(b, 6) = CleanPricingFields("P", Worksheets("Worksheet").Cells(b, 6))
Worksheets("Worksheet").Cells(b, 14) = Worksheets("Worksheet").Cells(b, 5) + Worksheets("Worksheet").Cells(b, 6)
Worksheets("Worksheet").Cells(b, 15) = CurrentAsin2
pos1 = InStr(1, Worksheets("Worksheet").Cells(b, 4), "01pSGAIMN3L.gif", vbTextCompare)
If pos1 > 0 Then
Worksheets("Worksheet").Cells(b, 4) = "Amazon"
End If
'Clean out the ratings
If Worksheets("Worksheet").Cells(b, 11) <> "" Then
pos1 = InStr(1, Worksheets("Worksheet").Cells(b, 11), "(", vbTextCompare)
If pos1 > 0 Then
Worksheets("Worksheet").Cells(b, 11) = Mid(Worksheets("Worksheet").Cells(b, 11), pos1, Len(Worksheets("Worksheet").Cells(b, 11)) - pos1)
Worksheets("Worksheet").Cells(b, 11) = Replace(Worksheets("Worksheet").Cells(b, 11), ",", "")
Worksheets("Worksheet").Cells(b, 11) = Replace(Worksheets("Worksheet").Cells(b, 11), " total ratings)", "")
Worksheets("Worksheet").Cells(b, 11) = Replace(Worksheets("Worksheet").Cells(b, 11), "(", "")
Worksheets("Worksheet").Cells(b, 11) = Replace(Worksheets("Worksheet").Cells(b, 11), "Seller Profile", 0)
Worksheets("Worksheet").Cells(b, 11) = Replace(Worksheets("Worksheet").Cells(b, 11), " total ratings", 0)
End If
End If
MoveNextLine:
Next
ErrHandler:
Select Case Err.Number
Case 0
Exit Sub
Case Else
MsgBox Err.Number & " " & Err.Description
Resume
Exit Sub
End Select
End Sub
Private Sub CreateWorksheetAndTitles()
Sheets.Add.Name = "Worksheet"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Title"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Brand"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Category"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Seller"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Shipping"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Price"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Sku"
Range("H1").Select
ActiveCell.FormulaR1C1 = "AliasSku"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Asin"
Range("J1").Select
ActiveCell.FormulaR1C1 = "SellerImage"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Ratings"
Range("L1").Select
ActiveCell.FormulaR1C1 = "StockNote"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Error"
Range("N1").Select
ActiveCell.FormulaR1C1 = "TotalCost"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Asin2"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Prime"
End Sub
Bookmarks