Finding the next empty cell

S

sncr137

New Member
Joined
Nov 14, 2015
Messages
26
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.

Code: 
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"
 
Last edited by a moderator:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Maybe this ....UNTESTED

Code: 
Sub MM1()
Dim r As Long, lastrow As Long
        Sheets("Purchasing").Unprotect
        For r = 1 To 150
        If Cells(r, 1).Value > "" And Cells(r, 10).Value = "" Then Exit Sub
        Sheets("Shopping Cart").Range(Cells(3, 1), Cells(100, 11)).Copy
        Sheets("Purchasing").Select
        lastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range("A" & lastrow).PasteSpecial Paste:=xlPasteValues
        Next r
        Range("Purch").Select
        Sheets("Purchasing").Protect AllowFiltering:=True
        Sheets("Shopping Cart").Range("H3:A3", "I3:J3").Select
        Range(Selection, Selection.End(xlDown)).select
        selection.ClearContents

    MsgBox "Thank You For Your Order"
End Sub
 
Upvote 0
You have the ingredients for the first blank row here:

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row

Just change it a bit with Offset:

Lastrow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

But you're not using it, so give this a shot (not tested):

Code: 
Sub foo()
    Dim r As Long
    Dim lr As Long
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    
    Set wsSource = Sheets("Shopping Cart")
    Set wsDest = Sheets("Purchasing")
        
        For r = 1 To 150
        '   Assuming you're starting on the Shopping Cart sheet, since you select the Purchasing sheet next
            If wsSource.Cells(r, 1).Value > "" And wsSource.Cells(r, 10).Value = "" Then Exit Sub
        Next r
                
        wsSource.Range(Cells(3, 1), Cells(100, 11)).Copy
        
        With wsDest
            .Unprotect
                lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                .Cells(lr, "A").PasteSpecial Paste:=xlPasteValues
            .Protect AllowFiltering:=True
        End With
        
        wsSource.Range("A3:J3").End(xlDown).ClearContents

    MsgBox "Thank You For Your Order"
    
End Sub

HTH,
 
Upvote 0
Thank you. I tried it but it still just keeps copying over the data that was pasted there before.

Maybe some clarification: I need the selected copy to go to "A1" of the "purchasing" sheet, locate the next empty cell and then special paste into that empty cell.
 
Upvote 0
I can't see why the other 2 codes would over-write but try the code below


Code: 
    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
        .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        .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"
 
Upvote 0
This works too except it is selecting a row way down the worksheet. I think this is my fault. I think I did not explain fully.

On the "Purchasing" sheet, the one I am pasting to, has a table that is sort-able. It has a header row in row 1 that goes from column A to K.

It seems to be locating the next row available after the table. So if the table goes to row 100, it is pasting in row 101.

Other than that it works great and I hope the further explanation helps.
 
Upvote 0
Do you have formulas in column A which use empty strings ie "" ?
 
Last edited:
Upvote 0
It seems that it is finding the last row of the table then selecting one more and then pasting.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
186
Possum17
P
C
  • Question
Calculations require application restart
Replies
2
Views
144
cpupartsplz
C
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
169
DanteAmor
DanteAmor
P
  • Question
Help with Vba Code
Replies
3
Views
149
Coyotex3
C
S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
125
sspatriots
S

Forum statistics

Threads
1,214,641
Messages
6,120,692
Members
448,979
Latest member
DET4492

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top