If cell value = something, then cut row and paste to next sheet

Rackette

New Member
Joined
Jul 2, 2019
Messages
37
Good afternoon and thank you for any help or advise.

I am trying to look through a dynamic range in column B and, where the column B value has a 2nd character = "E", then cut that entire row and paste it on to the next sheet.
There will be many times that column B will match my criteria, so the second worksheet's range will grow as more rows are removed from the first worksheet and pasted on to the 2nd one.

The value in B will look like: 6B230L, 5E431U, 6E226L, 6D537L...

In this example, I would need to cut the row with 5E431U and the row with 6E226L and paste them on to worksheet 2 and then continue looking through column B, doing the same type of thing, until I reach the bottom of the sheet.

I have seen may other macros that ALMOST do what I need, but the one that came closest didn't delete the blank row from the first sheet. It didn't actually cut the row, it just moved the data, I think.

-Christine
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
How about this. It assumes that your main sheet is sheet1 and the sheet to be copied to is sheet2.

Code:
Sub MXL201907201()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.UsedRange
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim DA As Object: Set DA = CreateObject("System.Collections.ArrayList")


For i = LBound(AR) + 1 To UBound(AR)
    If Mid(AR(i, 2), 2, 1) = "E" Then
        AL.Add Application.Index(AR, i, 0)
        DA.Add i
    End If
Next i


ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count, UBound(Application.Transpose(AL.toarray), 1)).Value = Application.Transpose(Application.Transpose(AL.toarray))


For j = DA.Count - 1 To 0 Step -1
    ws1.Rows(DA(j)).Delete
Next j


End Sub
 
Upvote 0
Thank you for taking the time to help. I really appreciate it.
When I run the code, I get a run-time error. Automation error and the debug shows this line in yellow: Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
 
Upvote 0
***Posted wrong code
 
Last edited:
Upvote 0
Ok, give this a shot.

Code:
Sub MXL201907201()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.UsedRange
Dim cnt As Long: cnt = 0
Dim AL() As Variant
Dim DA() As Variant

For i = LBound(AR) + 1 To UBound(AR)
    If Mid(AR(i, 2), 2, 1) = "E" Then
        ReDim Preserve AL(0 To cnt)
        ReDim Preserve DA(0 To cnt)
        AL(cnt) = Application.Index(AR, i, 0)
        DA(cnt) = i
        cnt = cnt + 1
    End If
Next i

ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AL) + 1, UBound(AL()(0), 1)).Value = Application.Transpose(Application.Transpose(AL))

For j = UBound(DA) To 0 Step -1
    ws1.Rows(DA(j)).Delete
Next j

End Sub
 
Upvote 0
Again, thank you for taking the time to help me.

I'm getting a run-time error again, but it's now happening at this line:

ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(AL) + 1, UBound(AL()(0), 1)).Value = Application.Transpose(Application.Transpose(AL))

It is a run-time error 5; Invalid procedure call or argument.
 
Upvote 0
Not sure why you are getting those errors. Both codes work fine on my test data. What version of Excel are you using?

Try this.

Code:
Sub MXL201907203()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.UsedRange
Dim cnt As Long: cnt = 0
Dim AL() As Variant
Dim LR As Long: LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

For i = UBound(AR) To 1 Step -1
    If Mid(AR(i, 2), 2, 1) = "E" Then
        ReDim Preserve AL(0 To cnt)
        AL(cnt) = Application.Index(AR, i, 0)
        ws1.Rows(i).Delete
        cnt = cnt + 1
    End If
Next i

For j = 0 To UBound(AL)
    For k = 1 To UBound(AL()(0), 1)
        ws2.Cells(LR, k) = AL()(j)(k)
    Next k
    LR = LR + 1
Next j

Application.ScreenUpdating = True
End Sub
 
Upvote 0
How about
Code:
Sub Rackette()
   With Sheets("Sheet1")
      .Range("A1").AutoFilter 2, "?E*"
      .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub
 
Upvote 0
Hmmm...if these work for both of you, then I'm going to assume that I'm the one doing something wrong. I'm using Office 365.
Fluff, I don't get any errors with your code, but it doesn't seem to do anything to my data. It runs, but nothing gets cut or pasted or changed in any way that I can see. Certainly nothing is being pasted to the second sheet.
Irobbo, I'm getting another run-time error 9, Subscript out of range with your most recent code at this line: For j = 0 To UBound(AL)
I am saving these in my Personal macro workbook. Is that what I'm supposed to be doing?
 
Upvote 0
Do you have a header in row 1 with data starting in A2?
Also the workbook containing the data needs to be the active workbook, when running the code.
 
Upvote 0

Forum statistics

Threads
1,213,524
Messages
6,114,117
Members
448,549
Latest member
brianhfield

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