Shopping Cart application

[Pablo]

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?

 

[akphidelt]

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

 

[Pablo]

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

 

[RB Smissaert]

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]

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]

Do this:

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


RBS

 

[bart.smissaert]

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.

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

 

[Pablo]

This is great! Thanks.

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

 

[Pablo]

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

 

[RB Smissaert]

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

RBS

 

[RB Smissaert]

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]

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]

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

Yes, can see no problem with that.

RBS