range only works once

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


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
SKUINV #Title / AuthorEA.StatusQtyTotal
1122854648​
9781853262104AR6132The Age Of Innocence Wordsworth Classics by Edith Wharton
£3.04​
ordered
1​
£3.04​
1264629799​
9780140007541BM2121The 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 totalCommissionPayment processing feeNet 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:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
I think that the code tags you tried using are for the old version of the forum (long time ago now, I can't remember anything that happened before breakfast), you can tag your code by selecting it in the reply window then clicking the vba icon on the toolbar, alternatively the </> icon will open a popup window that you can paste the code into.

A couple of observations.

You haven't set a workbook or sheet name where you're searching for Start and End of items which means that the last selected sheet is used. If you or your code move between workbooks or sheets then it could likely be looking at the wrong sheet.

With Range.Find it is wise to set all arguments in your code, those that you have omitted will default to last used which may not be as expected.

There could also be a variation that is preventing a match from being found. Noting that you're using xlWhole, a space at the end of the cell would cause it to be missed. If your data is copied from a web page then there could also be zero width characters which will cause the same problem. I haven't copied the table in your post to excel, but most likely it will contain zero width characters.
 
Upvote 0
I think that the code tags you tried using are for the old version of the forum (long time ago now, I can't remember anything that happened before breakfast), you can tag your code by selecting it in the reply window then clicking the vba icon on the toolbar, alternatively the </> icon will open a popup window that you can paste the code into.

A couple of observations.

You haven't set a workbook or sheet name where you're searching for Start and End of items which means that the last selected sheet is used. If you or your code move between workbooks or sheets then it could likely be looking at the wrong sheet.

With Range.Find it is wise to set all arguments in your code, those that you have omitted will default to last used which may not be as expected.

There could also be a variation that is preventing a match from being found. Noting that you're using xlWhole, a space at the end of the cell would cause it to be missed. If your data is copied from a web page then there could also be zero width characters which will cause the same problem. I haven't copied the table in your post to excel, but most likely it will contain zero width characters.
thank you so much now works and the first version had it at the top and i missed it
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top