Macro to cut and paste into a different worksheet

[Keegan1116]

Hi All, I've tried making this macro by recording the clicks, but that only works for the same cells every time. Attached is a spreadsheet that I use to track recipes that I make on a daily basis. I am trying to create a macro that, when run, it will cut and paste the cells that I hand select into another worksheet.

Source Worksheet: "Recipes"
Destination Worksheet: "Queue"

So I would like to be able to select a varying amount of rows, in this case (attached document), I would select Rows (12:22) in "Recipes" worksheet, then run the macro, which would cut and paste those selected cells into the "Queue" worksheet. An important point to note, is that there always needs to be 1 blank row in between each recipe, so when pasting, it will need to paste 2 rows beneath the previous recipe, unless of course it is the first recipe being pasted into the "Queue" worksheet, then it can go directly beneath the header. Sorry if that is confusing, but I haven't the slightest clue how to write that macro, even with the constant help from you guys and YouTube tutorials.

Thanks!

[mehmetcik]

Hi Keegan.

That should be quite easy.

However I think that we can improve on your stated requirement.

This will work as you describe it. However I have written it to allow you to select a single cell and it will copy from that cell to the next empty row.

I have modified the code this so it extends your selection up to the first empty row above.

Sub Test()

'Here I am creating an array containing the start and end cells of your selection.
'
'You only need to select one cell
'
If Selection.Cells.Count = 1 Then
SAddress = Split(Selection.Address & Selection.Address, "$")
Else
SAddress = Split(Replace(Selection.Address, ":", ""), "$")
End If

'Here I am extending your selection Up to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
SRow:
Set LLine = Range("A" & SAddress(2) - 1 & ":L" & SAddress(2) - 1)

If SAddress(2) > 2 And Application.TextJoin("", True, LLine) <> "" Then SAddress(2) = SAddress(2) - 1: GoTo SRow


'Here I am extending your selection Down to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
ERow:
Set LLine = Range("A" & SAddress(4) & ":L" & SAddress(4))

If Application.TextJoin("", True, LLine) <> "" Then SAddress(4) = SAddress(4) + 1: GoTo ERow


'Here I am cutting the selected range
    Range("A" & SAddress(2) & ":L" & SAddress(4)).Select
    Selection.Cut

'Here I am insertig the cut cells
    Sheets("Queue").Select
    Range("A2").Select
    Selection.Insert Shift:=xlDown

'Here I am deleting the original selection
    Sheets("Recipes").Select
    Selection.EntireRow.Delete
End Sub

[Keegan1116]

Will do mehmetcik! Thanks

[Keegan1116]

Hi Mehmetcik, I am getting a Run-Time error '9': Subscript out of range for the below part of the code.

Set LLine = Range("A" & SAddress(4) & ":L" & SAddress(4))

Also to clarify, you mention in the macro I only need to select one cell; does it mater which cell? or the first cell in the selection?

[Keegan1116]

Hi Mehmetcik, I'm having difficulty understanding what you meant in your edit to your comment where you posted the macro. You mentioned that:

This will work as you describe it. However I have written it to allow you to select a single cell and it will copy from that cell to the next empty row.

Now I think about it. I could modify this so it extends your selection up to the first empty row above.

I'm trying to have the macro select the entire recipe (columns A:L) all the way down to 1 row beneath where the "Total:" (flavor used) is showed, then cut and paste into the "Queue" worksheet. The trouble is, some recipes have 3 flavors, whereas some have up to 10. So that's the reason for me wanting to simply select the rows manually and run the macro. I'm not entirely sure if that's what you're attempting to accomplish but I thought it might be wise to clarify if I wasn't accurate in my first description.

In any case, the macro keeps giving me run-time errors, I must be doing something differently than you. I've tried selecting all rows manually, I've also tried just selecting the first cell with text in the recipe, which also didn't work. Will keep trying different things!

[mehmetcik]

This Version will allow you to select rows like you describe.

The 10000 is approx the number of cells in a row ( 16000 in my version) so you can select one cell, one row or multiples.

Sub Test()

'Here I am creating an array containing the start and end cells of your selection.
'
'You only need to select one cell
If Selection.Cells.Count = 1 Or Selection.Cells.Count > 10000 Then
SAddress = Split(Selection.Address & Selection.Address, "$")

Else
SAddress = Split(Replace(Selection.Address, ":", ""), "$")
End If

'Here I am extending your selection Up to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
SRow:
Set LLine = Range("A" & SAddress(2) - 1 & ":L" & SAddress(2) - 1)

If SAddress(2) > 2 And Application.TextJoin("", True, LLine) <> "" Then SAddress(2) = SAddress(2) - 1: GoTo SRow


'Here I am extending your selection Down to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
ERow:
Set LLine = Range("A" & SAddress(4) & ":L" & SAddress(4))

If Application.TextJoin("", True, LLine) <> "" Then SAddress(4) = SAddress(4) + 1: GoTo ERow


'Here I am cutting the selected range
    Range("A" & SAddress(2) & ":L" & SAddress(4)).Select
    Selection.Cut

'Here I am insertig the cut cells
    Sheets("Queue").Select
    Range("A2").Select
    Selection.Insert Shift:=xlDown

'Here I am deleting the original selection
    Sheets("Recipes").Select
    Selection.EntireRow.Delete
End Sub

[Keegan1116]

Odd - I am now getting the Run-Time error '438': Object doesn't support this property or method (this was with selecting the rows manually, as well as selecting one cell, the first cell with text in the recipe).

If SAddress(2) > 2 And Application.TextJoin("", True, LLine) <> "" Then

What exact method are you using before running the macro that works for you? Which cell do you select?

[mehmetcik]

I select any cell in the recipe. that works for me.

I have selected a single row in the recipe and that works for me.

Let me try selecting multiple rows.

I selected rows 26 to 37 and that worked for me.

So tell me what you select and see if I can replicate the error.

[Keegan1116]

Hmm. Cells 26 to 37 in the "Recipes" tab? On the document that I attached, that is halfway down one recipe, and halfway into the next recipe. I'm not so sure were using the same document though I can see why the cells would be different. I'm guessing that's why it wont work for me?

I attached the one I'm working on with the macro included (you should be able to see the error).

[mehmetcik]

Hi

I selected rows 12 to 20 and it worked.

[Keegan1116]

What the heck?!? It doesn't work for me! I selected rows 12:22 (dragging my cursor to select them all) then ran the macro, and got the same bloody error for this part of the code:

If SAddress(2) > 2 And Application.TextJoin("", True, LLine) <> "" Then SAddress(2) = SAddress(2) - 1: GoTo SRow

I'm on version (2010) 14.0.7258.5000, don't know if that makes a difference or not. I'm really at a loss here haha

[mehmetcik]

wait while I try that.

It worked for me.

maybe the error is before that. Does your version of excel have the TextJoin function?

This version gives you the Textjoin Function.

Sub Test()

'Here I am creating an array containing the start and end cells of your selection.
'
'You only need to select one cell
If Selection.Cells.Count = 1 Or Selection.Cells.Count > 10000 Then
SAddress = Split(Selection.Address & Selection.Address, "$")

Else
SAddress = Split(Replace(Selection.Address, ":", ""), "$")
End If

'Here I am extending your selection Up to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
SRow:
Set LLine = Range("A" & SAddress(2) - 1 & ":L" & SAddress(2) - 1)

If SAddress(2) > 2 And TEXTJOIN2("", True, LLine) <> "" Then SAddress(2) = SAddress(2) - 1: GoTo SRow


'Here I am extending your selection Down to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
ERow:
Set LLine = Range("A" & SAddress(4) & ":L" & SAddress(4))

If TEXTJOIN2("", True, LLine) <> "" Then SAddress(4) = SAddress(4) + 1: GoTo ERow


'Here I am cutting the selected range
    Range("A" & SAddress(2) & ":L" & SAddress(4)).Select
    Selection.Cut

'Here I am insertig the cut cells
    Sheets("Queue").Select
    Range("A2").Select
    Selection.Insert Shift:=xlDown

'Here I am deleting the original selection
    Sheets("Recipes").Select
    Selection.EntireRow.Delete
End Sub

Function TEXTJOIN2(Delimiter As String, IgnoreBlanks As Boolean, ParamArray Text() As Variant) As String
  Dim Item As Variant, V As Variant, Arr As Variant
  For Each Item In Text
    If VarType(Item) > 8191 Then
      For Each V In Item
        If Len(V) > 0 Or (Len(V) = 0 And Not IgnoreBlanks) Then TEXTJOIN2 = TEXTJOIN2 & Delimiter & V
      Next
    Else
      TEXTJOI2N = TEXTJOIN2 & Delimiter & Item
    End If
  Next
  TEXTJOIN2 = Mid(TEXTJOIN2, Len(Delimiter) + 1)
End Function

[Keegan1116]

I'm not entirely sure, it does not come up when I begin to type it into a cell, so I don't think so. Is there an alternative to TEXTJOIN I can try to see if that's the issue? I really appreciate all your time and help.

[Keegan1116]

IT WORKED!!! Thank you very much. You, are legend.

[mehmetcik]

This version gives you the Textjoin Function.

You can add the Textjoin function to your personal workbook and it will always be available for you to use in all your spreadsheets.

Sub Test()

'Here I am creating an array containing the start and end cells of your selection.
'
'You only need to select one cell
If Selection.Cells.Count = 1 Or Selection.Cells.Count > 10000 Then
SAddress = Split(Selection.Address & Selection.Address, "$")

Else
SAddress = Split(Replace(Selection.Address, ":", ""), "$")
End If

'Here I am extending your selection Up to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
SRow:
Set LLine = Range("A" & SAddress(2) - 1 & ":L" & SAddress(2) - 1)

If SAddress(2) > 2 And TEXTJOIN2("", True, LLine) <> "" Then SAddress(2) = SAddress(2) - 1: GoTo SRow


'Here I am extending your selection Down to find the first empty row
'I an using textjoin to check that columns A to L are empty
'
ERow:
Set LLine = Range("A" & SAddress(4) & ":L" & SAddress(4))

If TEXTJOIN2("", True, LLine) <> "" Then SAddress(4) = SAddress(4) + 1: GoTo ERow


'Here I am cutting the selected range
    Range("A" & SAddress(2) & ":L" & SAddress(4)).Select
    Selection.Cut

'Here I am insertig the cut cells
    Sheets("Queue").Select
    Range("A2").Select
    Selection.Insert Shift:=xlDown

'Here I am deleting the original selection
    Sheets("Recipes").Select
    Selection.EntireRow.Delete
End Sub

Function TEXTJOIN2(Delimiter As String, IgnoreBlanks As Boolean, ParamArray Text() As Variant) As String
  Dim Item As Variant, V As Variant, Arr As Variant
  For Each Item In Text
    If VarType(Item) > 8191 Then
      For Each V In Item
        If Len(V) > 0 Or (Len(V) = 0 And Not IgnoreBlanks) Then TEXTJOIN2 = TEXTJOIN2 & Delimiter & V
      Next
    Else
      TEXTJOI2N = TEXTJOIN2 & Delimiter & Item
    End If
  Next
  TEXTJOIN2 = Mid(TEXTJOIN2, Len(Delimiter) + 1)
End Function