Shopping Cart application
 

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?

Shopping Cart application
 

This would work a lot easier and allow for a lot more functions if you used
access.

"Pablo" wrote:

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?

Shopping Cart application
 

I know, but unfortunately I do not have that luxury.

"akphidelt" wrote:

This would work a lot easier and allow for a lot more functions if you used
access.

"Pablo" wrote:

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?

Shopping Cart application
 

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?

Shopping Cart application
 

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?

Shopping Cart application
 

Do this:

lRow = ActiveCell.Row
If Cells(lRow, 1) = 0 Or Cells(lRow, 1) = "" Then
Exit Sub
End If


RBS


"Pablo" wrote in message
...
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?

Shopping Cart application
 

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

Shopping Cart application
 

This is great! Thanks.

" 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

Shopping Cart application
 

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

Shopping Cart application
 

Will have a proper look later, but I think changing that Exit Sub into an
Exit For will make it work.

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

Shopping Cart application
 

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

Shopping Cart application
 

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

Shopping Cart application
 

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