Finding the next empty cell

[sncr137]

I am using the code below for a copy and paste operation. It is assigned to a button. My problem is it sends the first data no problem but when I repeat the operation it pastes over the last one. I need it to continually find the next empty cell. Any Advice is appreciated.

Truth be told I would like to do this without having to select the sheets when pasting.

Dim r As Long
        For r = 1 To 150
        If Cells(r, 1).Value > "" And Cells(r, 10).Value = "" Then Exit Sub
        Next r
        Sheets("Purchasing").Select
        Sheets("Purchasing").Unprotect
        Sheets("Shopping Cart").Select
        Range("A3").Select
        ActiveSheet.Range(Cells(3, 1), Cells(100, 11)).Select
        Selection.Copy
        Sheets("Purchasing").Select
        Range("A2").Select
        Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("Purch").Select
        Sheets("Purchasing").Protect AllowFiltering:=True
        Sheets("Shopping Cart").Select
        Application.CutCopyMode = False
        Range("H3:A3", "I3:J3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
        Range("A3").Select

    MsgBox "Thank You For Your Order"

 

[MARK858]

has a table that is sort-able

What is the name of the table?

 

[sncr137]

Table 2

 

[MARK858]

Try the code below. Make sure the spelling of the table tame is correct, in particular the space between Table and the number 2.

    Dim r As Long

    For r = 1 To 150
        If Cells(r, 1).Value > "" And Cells(r, 10).Value = "" Then Exit Sub
    Next r

    With Sheets("Purchasing")
        .Unprotect
        Sheets("Shopping Cart").Range(Sheets("Shopping Cart").Cells(3, 1), Sheets("Shopping Cart").Cells(100, 11)).Copy
        With .ListObjects("Table 2").Range
            .Cells(.Columns(1).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End With
        .Protect AllowFiltering:=True
        Application.CutCopyMode = False
    End With

    With Sheets("Shopping Cart")
        .Range("A3:J3").End(xlDown).ClearContents
        Application.Goto .Range("A3")
    End With

    MsgBox "Thank You For Your Order"

 

[sncr137]

That works perfect. Thank you so much for the help. This site has been one of the best resources for trying to learn the ins and outs of VBA.

 

[MARK858]

You're welcome

 

[portews]

You also don't need to select anything. You can just reference the cells

For instance,

ActiveSheet.Range(Cells(3, 1), Cells(100, 11)).Select
Selection.Copy

becomes

ActiveSheet.Range(Cells(3, 1), Cells(100, 11)).Copy

Try this:

Dim lastrow as Long
Dim shlastrow as Long
Dim r As Long
Sheets("Purchasing").Unprotect
For r = 3 To 150
    If Cells(r, 1).Value > "" And Cells(r, 10).Value = "" Then Exit Sub
Next r
lastrow = Sheets("Purchasing").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Shopping Cart").Range(Cells(3, 1), Cells(100, 11)).Copy Destination:=Sheets("Purchasing").Cells(lastrow, 1)
Sheets("Purchasing").Protect AllowFiltering:=True
shlastrow = Sheets("Shopping Cart").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Shopping Cart").Range(Cells(3, 1), Cells(shlastrow, 10)).ClearContents
Range("A3").Select
Application.CutCopyMode = False
MsgBox "Thank You For Your Order"

 

[MARK858]

Hi portews, that code won't work for the OP, it works with a normal range (as do the other codes) but not within a "Table" (by table I mean put some data in column A in a sheet called Sheets("Purchasing"), select the data and say 4 extra rows down then click the Insert tab then Table).

then put some data in Sheets("Shopping Cart").Range("A3:K100") and run the code

The code will paste further down (see posts #5 & #6) than the last cell with data.


You also need to qualify the Cells as well as the Range in

Sheets("Shopping Cart").Range(Cells(3, 1), Cells(100, 11)).Copy

like

Sheets("Shopping Cart").Range(Sheets("Shopping Cart").Cells(3, 1), Sheets("Shopping Cart").Cells(100, 11)).Copy

or

With Sheets("Shopping Cart")
 .Range([COLOR="#FF0000"][B].[/B][/COLOR]Cells(3, 1), [COLOR="#FF0000"][B].[/B][/COLOR]Cells(100, 11)).Copy
End With

or else the code will error unless you are on Sheets("Shopping Cart") when you run the code.