# [SOLVED] Add to Cart - Excel Macro



## DanielA777 (Jun 25, 2012)

Hey Guys,

I'm after some help on creating a Button Macro,

What I need it to do is copy information from selected areas and paste it down onto the quote form (As Per Below Picture). But if the Line is Taken, it will go to the next line, up to 10 Times.

Currently what I am planing to do is make a button per line item, but that is impracticable. Any Idea's would be appreciated.



> Sub Line_Item_1()
> '
> ' Line_Item_1 Macro
> '
> ...












Is this possible with a little bit of help, or am I out of my league here?

Cheers,

Daniel


----------



## AlbertMC2 (Jul 15, 2010)

*Re: "Add to Cart/Quote" Excel Macro*

Hi

You can try something like:

```
Sub SelectEmptyCell()
    'See if quote full
    'if quote not full then add item
    If Application.WorksheetFunction.CountA(Range("a3:a12")) < 10 Then
        Range("A1:E1").Select 'select item range to add
        Selection.Cut 'cut item
        'search for first empty row on quote in specified range
        Range("A3:A12").Find(What:="", _
                After:=[A12], LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Activate
        ActiveSheet.Paste 'paste item on quote
    Else ' if quote full give message
        MsgBox "Quote Full"
    End If
End Sub
```
Where range a3:a12 is the range where you want the items to display on your quote
ie lines 1-10 of your quote.
Where range a1:e1 is the item you want to add to the first empty line of your quote.

You will have to modify the ranges to the ranges you are using.


----------



## DanielA777 (Jun 25, 2012)

*Re: "Add to Cart/Quote" Excel Macro*

Thanks mate,

This looks promising, although I have a small problem,

Its having trouble copy and pasting from merged cells,

The Error I am getting is 
"This operation requires the merged cells to be identical sized"

The current codes I'm working with is,

Witch is trying to un-merge cells when it pastes.


```
Sub Line_Item_1()
   'Line_Item_1 Macro
    'See if quote full
    'if quote not full then add item
    If Application.WorksheetFunction.CountA(Range("B43:B52")) < 10 Then
    Range("B33:P33").Select
    'select item range to add
    Selection.Copy 'COPY item
    'search for first empty row on quote in specified range
    Range("B43:B52").Find(What:="", _
    After:=[B52], LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, _
    SearchFormat:=False).Activate
    Selection.PasteSpecial (xlPasteValues)
       Else ' if quote full give message
        MsgBox "Quote Full"
    End If
           
End Sub
```










Any ideas with out un merging the cells? If that is required the whole spread sheet will be buggered,
:hide:
Regards,

Daniel,


----------



## AlbertMC2 (Jul 15, 2010)

*Re: "Add to Cart/Quote" Excel Macro*

Hi

From your last picture it looks like the merged cells line up so I cannot show you on your example what you can try. So, once again using my example, which you will have to modify to use your cells/ranges, you can try something like this:

```
Sub SelectEmptyCell()
    'See if quote full
    'if quote not full then add item
    If Application.WorksheetFunction.CountA(Range("A3:A12")) < 10 Then
        Dim fRow As Integer
        'search for first empty row on quote in specified range
        'and assign "fRow" to row number
        fRow = Range("A3:A12").Find(What:="", _
                After:=[A12], LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Row
        'copy cell for cell
        Range("A" & fRow).Value = Range("A1").Value
        Range("B" & fRow).Value = Range("B1").Value
        Range("C" & fRow).Value = Range("C1").Value
        Range("D" & fRow).Value = Range("D1").Value
        Range("E" & fRow).Value = Range("E1").Value
        Range("F" & fRow).Value = Range("F1").Value
    Else ' if quote full give message
        MsgBox "Quote Full"
    End If
End Sub
```


----------



## DanielA777 (Jun 25, 2012)

*Re:*SOLVED* "Add to Cart/Quote" Excel Macro*

AlbertMC2,

Thank you very much!

It works perfectly after I entered my own Ranges. It does not have a problem with obtaining values from Cells that are merged either, great code.

I think I will be using something similar to this to create a Quote register as well.

My Final code is as per below;

```
Sub Add_to_Cart()
'See if quote full
    'if quote not full then add item
    If Application.WorksheetFunction.CountA(Range("B43:B52")) < 10 Then
        Dim fRow As Integer
        'search for first empty row on quote in specified range
        'and assign "fRow" to row number
        fRow = Range("B43:B52").Find(What:="", _
                After:=[B52], LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Row
        'copy cell for cell
        Range("B" & fRow).Value = Range("B21").Value
        Range("C" & fRow).Value = Range("F15").Value
        Range("I" & fRow).Value = Range("G7").Value
        Range("K" & fRow).Value = Range("G8").Value
        Range("M" & fRow).Value = Range("J12").Value
        Range("O" & fRow).Value = Range("J13").Value
    Else ' if quote full give message
        MsgBox "Quote Full - Goodwork"
    End If
End Sub
```
Cheers,

Daniel :thumb:


----------

