can I change the With Sheets ("Items) reference to ActiveSheet.object?

Yes, can see no problem with that.

RBS


"Pablo" wrote in message
...
Thanks.

One last question. I have multiple worksheets with products so can I
change
the With Sheets ("Items) reference to ActiveSheet.object? If it is a big
deal
I can live with one sheet.

"RB Smissaert" wrote:

Try this one.
It has the available items in a sheet called Items and the Chart items in
a
sheet called Chart.
Most work is done in arrays as that tends to be faster.


Sub AddToCart()

Dim n As Long
Dim i As Long
Dim c As Long
Dim lItems As Long
Dim lCartItems As Long
Dim arrItem(1 To 1, 1 To 6)
Dim arrItems
Dim arrCart
Dim bCartItemUpdated As Boolean

With Sheets("Items")
'number of items in Items sheet
lItems = Cells(65536, 1).End(xlUp).Row - 1
'all the available items
arrItems = Range(Cells(2, 1), Cells(lItems + 1, 6))
End With

With Sheets("Cart")
'as there could be same number of rows in Cart as in Items
arrCart = Range(.Cells(2, 1), .Cells(lItems + 1, 6))
'number of unique items present in Cart
lCartItems = .Cells(65536, 1).End(xlUp).Row - 1
End With

For n = 1 To lItems 'loop through all items

If Val(arrItems(n, 1)) 0 Then

'get the unique item(s) to buy, this corresponds to one row in
items
sheet

'-------------------------------------------------------------------------
For c = 1 To 6
arrItem(1, c) = arrItems(n, c)
Next c

bCartItemUpdated = False

'QTY, SKU, ISBN, Description, Price, Extended Price
'---------------------------------------------------
For i = 1 To lCartItems
'see if SKU or ISBN are same
If arrItem(1, 2) = arrCart(i, 2) Or _
arrItem(1, 3) = arrCart(i, 3) Then
'update existing cart item
'-------------------------
'QTY
arrCart(i, 1) = arrCart(i, 1) + arrItem(1, 1)
'Price
arrCart(i, 5) = arrCart(i, 5) + arrItem(1, 5) * arrItem(1, 1)
'Extended Price
arrCart(i, 6) = arrCart(i, 6) + arrItem(1, 6) * arrItem(1, 1)

bCartItemUpdated = True
Exit For

End If
Next i 'For i = 1 To lCartItems

'add new cart item if no existing cart item was updated
'------------------------------------------------------
If bCartItemUpdated = False Then
lCartItems = lCartItems + 1
For c = 1 To 6
arrCart(lCartItems, c) = arrItem(1, c)
Next c
End If

End If 'If Val(arrItems(n, 1)) 0

Next n

'finally update the sheet Cart
'-----------------------------
With Sheets("Cart")
Range(.Cells(2, 1), .Cells(lCartItems + 1, 6)) = arrCart
End With

End Sub


RBS


"Pablo" wrote in message
...
Bart,

Thanks again. When I originally put this in it was only updating the
first
row and then exiting. I commented out the Exit Sub statement and some
slight
modifications so now it updates correctly but because I commented the
Exit
Sub is duplicates the row updates. I am not how to exit the sub and
still
update all the rows and add anything new. I tried moving the Exit Sub
around
but nothing seems to work.

For n = 2 To LRItems 'loop through all items

If Val(Cells(n, 1)) 0 Then

'get the item(s) to buy
arrItem = Range(Cells(n, 1), Cells(n, 7))

'QTY, SKU, ISBN, Level, Description, Price, Extended Price
'---------------------------------------------------
With Sheets("Shopping Cart")

LRCart = .Cells(65536, 1).End(xlUp).Row
arrInCart = Range(.Cells(2, 1), .Cells(LRCart, 7))

For i = 1 To UBound(arrInCart)
If arrItem(1, 2) = arrInCart(i, 2) Or _
arrItem(1, 3) = arrInCart(i, 3) Then
'update existing cart item
'-------------------------
.Cells(i + 1, 1) = arrItem(1, 1) 'QTY
.Cells(i + 1, 6) = arrItem(1, 6) 'Price
.Cells(i + 1, 7) = arrItem(1, 7) 'Extended Price

Else
'add new cart item
Range(.Cells(LRCart + 1, 1), _
.Cells(LRCart + 1, 7)) = arrItem
'Exit Sub
End If
Next i

End With

End If

Next n

" wrote:

On 7 Feb, 04:27, Pablo wrote:
Thank you very much. This is a big step in the right direction. I
created a
button and attached the script to it, but it only picks up what its
content
in the selected row whether or not there is a quantity. Ideally, the
script
runs through a range (A4:A...) and if cells A6, A10, & A28 contain a
value
those rows (A:G) is copy/paste to the Cart.

Thanks again.

"RB Smissaert" wrote:
Something like this should do it:

Sub AddToCart()

Dim i As Long
Dim lRow As Long
Dim LRCart As Long
Dim arrItem
Dim arrInCart

'get the item(s) to buy
lRow = ActiveCell.Row
arrItem = Range(Cells(lRow, 1), Cells(lRow, 6))

'QTY, SKU, ISBN, Description, Price, Extended Price
'---------------------------------------------------
With Sheets("Cart")
LRCart = .Cells(65536, 1).End(xlUp).Row
arrInCart = Range(.Cells(2, 1), .Cells(LRCart, 6))

For i = 1 To UBound(arrInCart)
If arrItem(1, 2) = arrInCart(i, 2) Or _
arrItem(1, 3) = arrInCart(i, 3) Then
'update existing cart item
.Cells(i + 1, 1) = .Cells(i + 1, 1) + arrItem(1, 1) 'QTY
.Cells(i + 1, 5) = .Cells(i + 1, 5) + arrItem(1, 5) *
arrItem(1, 1)
'Price
.Cells(i + 1, 6) = .Cells(i + 1, 6) + arrItem(1, 6) *
arrItem(1, 1)
'Extended Price
Exit Sub
End If
Next i

'add new cart item
Range(.Cells(LRCart + 1, 1), .Cells(LRCart + 1, 6)) = arrItem
End With

End Sub

This presumes the 6 fields as in the commented line and a sheet
call
Cart.
You will need to add some error handling, but that is about it.

RBS

"Pablo" wrote in message
...
I found a discussion thread that talks about creating a shopping
cart like
application but there did not seem like there was any
resolution. I
have a
workbook with 8 reference order spreadsheets that are all layout
out in
the
same format. Customers are able to browse the spreadsheets and
select
various
items from various sheets. I would like to create an "Add to
Cart"
button
on
each sheet with a script the takes the items selected on that
sheet
and
adds
them to a "Cart" sheet. I would think I could test the cells in
Column A
(Qty) and then grab the row for colums A:F. I am not sure how to
paste
into
the next empty row of the "Cart" sheet, while checking for
duplicates and
pasting over previous entries. The SKU and ISBN are unique
values.

Spreadsheet Format
Qty, SKU, ISBN, ..., Description, Price, Extended Price

Has anyone done something like this before, or any ideas?

OK, I thought you want to deal with only one row in the items sheet.
In that case you need 2 loops, something like this (not tested):

Sub AddToCart()

Dim n As Long
Dim i As Long
Dim lRow As Long
Dim LRItems As Long
Dim LRCart As Long
Dim arrItem
Dim arrInCart

'last usable row in items sheet
LRItems = Cells(65536, 1).End(xlUp).Row

For n = 2 To LRItems 'loop through all items

If Val(Cells(n, 1)) 0 Then

'get the item(s) to buy
arrItem = Range(Cells(n, 1), Cells(n, 6))

'QTY, SKU, ISBN, Description, Price, Extended Price
'---------------------------------------------------
With Sheets("Cart")
LRCart = .Cells(65536, 1).End(xlUp).Row
arrInCart = Range(.Cells(2, 1), .Cells(LRCart, 6))

For i = 1 To UBound(arrInCart)
If arrItem(1, 2) = arrInCart(i, 2) Or _
arrItem(1, 3) = arrInCart(i, 3) Then
'update existing cart item
'-------------------------
'QTY
.Cells(i + 1, 1) = _
.Cells(i + 1, 1) + arrItem(1, 1)
'Price
.Cells(i + 1, 5) = _
.Cells(i + 1, 5) + arrItem(1, 5) * arrItem(1, 1)
'Extended Price
.Cells(i + 1, 6) = _
.Cells(i + 1, 6) + arrItem(1, 6) * arrItem(1, 1)
Exit Sub
End If
Next i

'add new cart item
Range(.Cells(LRCart + 1, 1), _
.Cells(LRCart + 1, 6)) = arrItem
End With

End If

Next n

End Sub


RBS