Move Row into new sheet based on cell value

[cheezy]

Hi Guys,

New here.

I have been searching the web and these forums and cannot find a specific solution.

I need write a VBA code that will move an entire row into a new sheet if the value of the last cell says "YES"
If the value is blank then Id like it to stay in the current sheet.
I would also like it if the cell wont allow any other value other than Yes to be typed.

I found this code here:

http://www.mrexcel.com/forum/excel-questions/397784-copy-move-delete-row-based-cell-value.html

THE VERY FIRST CODE REPLIED IN THAT THREAD.



I just cannot seem to get it to work. Simply copying and pasting that into the module doesn't work. I am not very good at VBA and just started taking a course on VBA.
Id like to jump into this problem asap as I need it for work.





Basically:

Columns A:E will have values. In Column E I would like to type in Yes if completed.
I would like the Macro to run through all of Column E and if the cell value is "YES" then I want it to cut the entire row and paste into a new sheet.
In the new sheet I would like it to be pasted into the next available row.

Also can I create this with a ActiveX control button? I would like to have a button that I can click at the end of my work which will run the Macro in sheet 1.

Thanks a lot guys an help is appreciated!

 

[dermie_72]

Try this and see how you go. You may need to modify some of the fields to suit your needs.

When it comes to adding a button, I personally find a shortcut key is better, but you can add the buttom with the form menu, and assign this macro to it that way.

It could probably be simplified, and prettied up by some more experienced members, but it should do as requested.

Sub Cheezy()
'move rows from sheet 1 to sheet 2 if column E has a Yes in it.
'for http://www.mrexcel.com/forum/excel-questions/673106-move-row-into-new-sheet-based-cell-value.htmlDim Check As Range
Lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
If lastrow2 = 1 Then
    lastrow2 = 0
    Else
End If
Do While Application.WorksheetFunction.CountIf(Range("E:E"), "Yes") > 0
    Set Check = Range("E1:E" & Lastrow)
    For Each Cell In Check
        If Cell = "Yes" Then
            Cell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
            Cell.EntireRow.Delete
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next
Loop
End Sub

 

[MUKESHY12390]

Hey try this one..!!
I Have code.. that work Fine for me....!!!

-------------------------------------------------------------------------------
Dim P_text As String
Sub compil_two()
P_text = InputBox("Enter Your Text")


Workbooks.Open "C:\Users\qbe1010\Desktop\Excel Files\Dump.xlsx"
Call test_two

Workbooks("Dump.xlsx").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub
-----------------------------
Sub test_two()


Range("c6000").End(xlUp).Select
Range(ActiveCell, Range("c2")).Select




For Each cell In Selection
If cell.Value = P_text Then
cell.EntireRow.Copy
Workbooks("Consolidation.xlsm").Activate
Range("c5000").End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
End If
Next

End Sub


------------------------

Just you have to change Bold data with your requirement..!!!

replay in case of any trouble with above code....!!

Thank You..!

 

[Michael M]

also

Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
        If Range("E" & r).Value = "Yes" Then
            Rows(r).Cut Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next r
Application.ScreenUpdating = True
End Sub

 

[cheezy]

also

Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
        If Range("E" & r).Value = "Yes" Then
            Rows(r).Cut Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next r
Application.ScreenUpdating = True
End Sub

WORKS Perfect. I most likely will clean it up and make it more to my uses. But that is exactly what I need. You guys are awesome and so fast. Cant wait to learn VBA and be able to do all this. Will Write back if I need anymore help. THANKS SO MUCH!

 

[Michael M]

Glad it worked...and thanks for the feedback..

 

[Michael M]

Could also use this quicker version

Sub MM2()
Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
    With ActiveSheet.Rows("1:" & lr)
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="Yes", Operator:=xlAnd
        .SpecialCells(xlCellTypeVisible).EntireRow.Cut Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").UsedRange.Rows.Count + 1)
        .Autofilter    
End With
End Sub

 

[Kurt]

Could also use this quicker version

Sub MM2()
Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
    With ActiveSheet.Rows("1:" & lr)
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="Yes", Operator:=xlAnd
        .SpecialCells(xlCellTypeVisible).EntireRow.Cut Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").UsedRange.Rows.Count + 1)
        .Autofilter    
End With
End Sub

found these really good examples of how to move rows to another worksheet based on a cell's value while doing a search.

Let's say on Sheet1 you keep adding items daily to the spreadsheet and you want to leave the old items there.

How would you know where to start the range where the code starts to look?

 

[aron1987]

Good morning,

I'm trying to do something similar to the above.

I have a excel sheet that has rows of data and want to copy those rows only if the first column equals certain text

I have a sheet called "Master List" and it shows those staff who have been absent for work. What I want to be able to do is that anyone from "BNE Packing" I can copy to another sheet, anyone from "BNE Trimming" I can copy to another sheet etc.

May I please have some guidance on how to do this?

BNE Trimming	Bob	Smith	Sick Leave	29/12/17
BNE Packing	Anne	Jameson	Sick Leave - Unpaid	25/12/17
BNE Packing	Jane	Conrod	Sick Leave	22/12/17

<tbody>
</tbody>

 

[Michael M]

do you only have the 2 categories..."Trimming" and "Packing" ???