EDUCATED MONKEY
Board Regular
- Joined
- Jul 17, 2011
- Messages
- 218
I am using vba to extract data from a sheet; this data is connected with book sales as such i sell books on different sites so need slightly different version of the same code
the first code I wrote for one of the sites works perfectly, now I am have weird problems with the second one, I am using range to find a particular row in the sheet based upon a given word which appears in this case column A
This issue happens when there is more than one book to extract again most stress this work perfectly on the data from the first site
when the code runns for the first time it find the row that contains the book info and extracts it so I then delete that row and loop back to the top this time MsgBox "startOfItems not found" and MsgBox "endOfItems not found" get displayed
and like i said this is exactly the same process as the first site the only difference is the number of rows between books
this is how the sheet look for the firs pass
column A column B
row 21 SKU INV # Title / Author EA. Status Qty Total
row 22 1122854648 9781853262104AR6132 The Age Of Innocence Wordsworth Classics by Edith Wharton £3.04 ordered 1 £3.04
row 23 1264629799 9780140007541BM2121 The Plumed Serpent by D. H Lawrence £3.04 ordered 1 £3.04
row 24 Subtotal: £6.08
and this is how it looks after row 22 gets deleted
row 21 SKU INV # Title / Author EA. Status Qty Total
row 23 1264629799 9780140007541BM2121 The Plumed Serpent by D. H Lawrence £3.04 ordered 1 £3.04
row 24 Subtotal: £6.08
so the range markers are still there these being SKU and Subtotal:
now if i ignor the not found messages it completes as i close each one with the side effect that it grabs the wrong data for the date for the second book
test data
i have now been looking at this for far too long and should have asked for help before now
thanks
the first code I wrote for one of the sites works perfectly, now I am have weird problems with the second one, I am using range to find a particular row in the sheet based upon a given word which appears in this case column A
This issue happens when there is more than one book to extract again most stress this work perfectly on the data from the first site
VBA Code:
Set startOfItems = Range("a:a").Find("SKU", Lookat:=xlWhole)
If Not startOfItems Is Nothing Then
location = startOfItems.Row
'MsgBox (location)
Else
MsgBox "startOfItems not found"
End If
Set endOfItems = Range("a:a").Find("Subtotal:", Lookat:=xlWhole)
If Not endOfItems Is Nothing Then
location4 = endOfItems.Row
'MsgBox (location4)
Else
MsgBox "endOfItems not found"
End If
when the code runns for the first time it find the row that contains the book info and extracts it so I then delete that row and loop back to the top this time MsgBox "startOfItems not found" and MsgBox "endOfItems not found" get displayed
and like i said this is exactly the same process as the first site the only difference is the number of rows between books
this is how the sheet look for the firs pass
column A column B
row 21 SKU INV # Title / Author EA. Status Qty Total
row 22 1122854648 9781853262104AR6132 The Age Of Innocence Wordsworth Classics by Edith Wharton £3.04 ordered 1 £3.04
row 23 1264629799 9780140007541BM2121 The Plumed Serpent by D. H Lawrence £3.04 ordered 1 £3.04
row 24 Subtotal: £6.08
and this is how it looks after row 22 gets deleted
row 21 SKU INV # Title / Author EA. Status Qty Total
row 23 1264629799 9780140007541BM2121 The Plumed Serpent by D. H Lawrence £3.04 ordered 1 £3.04
row 24 Subtotal: £6.08
so the range markers are still there these being SKU and Subtotal:
now if i ignor the not found messages it completes as i close each one with the side effect that it grabs the wrong data for the date for the second book
test data
BiblioDirect, Tools for Independent Booksellers | ||||||
INVENTORY | ||||||
ORDERS | ||||||
PURCHASES | ||||||
ACCOUNT | ||||||
PROMOTIONS | ||||||
HELP | ||||||
Search by SKU/Book ID | ||||||
Back to list | ||||||
Order 1004-8932633-4477117 | ||||||
Add Tracking | ||||||
Tracking #: | ||||||
Shipping Service: | ||||||
Royal Mail | ||||||
Include a note in the tracking email | ||||||
Ship To: | ||||||
William Pittam | ||||||
3 Salcombe Villas | ||||||
London, London TW10 6AR | ||||||
United Kingdom | ||||||
SKU | INV # | Title / Author | EA. | Status | Qty | Total |
1122854648 | 9781853262104AR6132 | The Age Of Innocence Wordsworth Classics by Edith Wharton | £3.04 | ordered | 1 | £3.04 |
1264629799 | 9780140007541BM2121 | The Plumed Serpent by D. H Lawrence | £3.04 | ordered | 1 | £3.04 |
Subtotal: | £6.08 | |||||
Shipping: | £0.00 | |||||
Total: | £6.08 | |||||
Transaction details: Credited on 8/25/2020 (all amounts in USD): | ||||||
Order total | Commission | Payment processing fee | Net due to you | |||
$7.73 | -$1.42 | -$0.74 | $5.57 | |||
Order Summary | ||||||
Status | ||||||
SHIPPED | ||||||
Customer | ||||||
William Pittam | ||||||
Customer Email | ||||||
william.pittam@gmail.com | ||||||
Ordered on | ||||||
Aug 11, 2020 | ||||||
Delivery Method | ||||||
Standard | ||||||
Delivery days | ||||||
7 - 10 days | ||||||
Delivery Window | ||||||
Tue, Aug 18th - Fri, Aug 21st | ||||||
Packing Slip | ||||||
Packing Slip | ||||||
Received from | ||||||
Biblio.co.uk | ||||||
Payment via | ||||||
Payment has been received from the customer by Biblio.com | ||||||
Issue a Refund | ||||||
You will have the option to choose a full or partial refund |
VBA Code:
Option Explicit
Sub extractBiblioData()
Dim startOfAddress As Range
Dim endOfAddress As Range
Dim addr As Long
Dim numberOfLinesInAddress As Integer
Dim i As Integer
Dim j As Integer
Dim b As Long
Dim lastRow2 As Long
Dim location1 As Long ' where the addres starts
Dim location2 As Long ' where the address ends
Dim location3 As Long ' where the Purchase Order is
Dim location As Long ' where items start
Dim location4 As Long ' where items end
Dim numberOfBooks(10) As Variant 'possible ten books sold to one person
Dim authorInString As String
Dim title As String
Dim author As String
Dim split As Integer
Dim purchaseDate As Range
Dim ordered As String
Dim startOfItems As Range
Dim endOfItems As Range
Dim book As String
Dim locationDate As Long
Dim postalAddress1 As String
Dim rowToDelete As Long
start2:
i = 0
j = 0
Set startOfItems = Range("a:a").Find("SKU", Lookat:=xlWhole)
If Not startOfItems Is Nothing Then
location = startOfItems.Row
Else
MsgBox "startOfItems not found"
End If
Set endOfItems = Range("a:a").Find("Subtotal:", Lookat:=xlWhole)
If Not endOfItems Is Nothing Then
location4 = endOfItems.Row
Else
MsgBox "endOfItems not found"
End If
For b = location To location4
book = Worksheets("copiedData").Cells(b, 1).value
If IsNumeric(book) Then
numberOfBooks(j) = b 'increase j each time a number is encountered thus count books
j = j + 1
End If
Next b
Set purchaseDate = Range("a:a").Find("Ordered on", Lookat:=xlWhole)
If Not purchaseDate Is Nothing Then
locationDate = purchaseDate.Row
Else
MsgBox "purchaseDate not found"
End If
Set startOfAddress = Range("a:a").Find("Ship To:", Lookat:=xlWhole)
If Not startOfAddress Is Nothing Then
location1 = startOfAddress.Row + 1
Else
MsgBox "address not found"
End If
Set endOfAddress = Range("a:a").Find("SKU", Lookat:=xlWhole)
If Not endOfAddress Is Nothing Then
location2 = endOfAddress.Row - 1
Else
MsgBox "address not found"
End If
numberOfLinesInAddress = location2 - location1
For addr = location1 To location2
postalAddress1 = Worksheets("copiedData").Cells(addr, 1).value
varData(i) = postalAddress1 'put the addres of customer into an array
i = i + 1
Next addr
ordered = Worksheets("copiedData").Cells(locationDate + 1, 1).value
authorInString = Worksheets("copiedData").Cells(location2 + 2, 3).value
split = InStr(1, authorInString, "by", 0)
author = Mid(authorInString, split + 3, Len(authorInString) - split)
title = Left(authorInString, split - 2)
Sheets("extractedData").Select
lastRow2 = Cells(Rows.Count, 1).End(xlUp).Row + 1 ' looks in Col A
Worksheets("extractedData").Cells(lastRow2, 1).value = ordered
Worksheets("extractedData").Cells(lastRow2, 5).value = title
Worksheets("extractedData").Cells(lastRow2, 6).value = author
Worksheets("extractedData").Cells(lastRow2, 9).value = "biblio"
Call extraxtDataFromString(lastRow2, i, 2) 'module 14
If j > 1 Then
rowToDelete = numberOfBooks(0)
'MsgBox ("book at " & rowToDelete)
Worksheets("copiedData").Rows(rowToDelete).Delete
GoTo start2:
End If
End Sub
i have now been looking at this for far too long and should have asked for help before now
thanks
Last edited by a moderator: