VBA to move a row to another sheet based on criteria

[survivalbloke]

Hello. First off, I apologize for having to ask this because I'm certain that the solution has already been posted elsewhere in this community, but I'm actually so inept in Excel, I'm not entirely sure I would recognize the solution if I saw it, so I'm asking. If based on my question, you know where a thread is which has solved this, please let me know!

I would like a way to automatically move an entire row to another sheet based on the contents of a specific cell in a row. Here's my(extremely simplified) example:

	A	B
	ITEM	STATUS
1	item 1	for sale
2	item 2	sold

<tbody>
</tbody>

In the above example, we will call that sheet "Inventory", and the second sheet(not shown) will be called "Sold". What I'd like is a way to automatically move any column which has a "status" of "sold". In the above example, row 2 should be moved to the sheet named "Sold". I'm hoping that is clear, but if for some reason it isn't, I'll explain what I'm doing. I've got a spreadsheet(which was made awesome thanks to the folks here) I use to track inventory. When I get inventory, I enter it in the "Inventory" sheet of the workbook. Once something is sold and no longer available, I cut and paste that row from the "Inventory" sheet to the "Sold" sheet.

Also, if this solution is based on VBA, how does one execute a VBA script?

Thanks!

 

[My Aswer Is This]

Try this:

This is a auto sheet event script
Your Workbook must be Macro enabled
To install this code:

Right-click on the sheet tab named "Inventory"
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

When you enter the value "Sold" into column "B" the script will do what you asked for.
You must have a sheet named "Sold"

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1

If Target.Value = "Sold" Then Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End Sub

 

[survivalbloke]

Try this:

This is a auto sheet event script
Your Workbook must be Macro enabled
To install this code:

Right-click on the sheet tab named "Inventory"
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

When you enter the value "Sold" into column "B" the script will do what you asked for.
You must have a sheet named "Sold"

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1

If Target.Value = "Sold" Then Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End Sub

MIND = BLOWN.

That worked exactly how I pictured it working. Thank you!

 

[L. Howard]

Try this in a standard module.

From the Inventory sheet, do Alt + f11 to get to the VB Editor.

Find the word Insert in the tool bar at the top left of the VB Editor. Click it and select Module from the drop down.

Copy the code here and paste in the new Module, it will be Module1 in the project Explorer, where you will also see the sheets you have in your workbook. Inventory and Sold will also be there, if you have so named them as such.

The Option Compare Text will allow the code to disregard case when looking for the word "sold", so SOLD, sold or Sold will play nice with the code.

Alt + f11 back to Inventory sheet.

You can assign the code a button from the Forms Controls, click on the Developer tab > Controls > Insert > click on the Button Icon and then on the sheet, left click and hold, drag down and right to size the button. Click anywhere off the new button (on the sheet). Now right click the button > Assign Macro > select Row_Sold_Cut > OK. Click the button to run the code.

Or you can also run the code by doing Alt + f8 > select Row_Sold_Cut > Run.

Give it a go and post back if you have problems.

Howard

Option Explicit
Option Compare Text

Sub Row_Sold_Cut()
Dim LRow As Long, LCol As Long
Dim rngC As Range

With Sheets("Inventory")
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row

For Each rngC In .Range("B1:B" & LRow)

   LCol = Cells.Find(What:="*", After:=[a1], _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column

   If InStr(rngC, "sold") > 0 Then
     rngC.Offset(, -1).Resize(1, LCol).Cut Sheets("Sold").Range("A" & Rows.Count).End(xlUp)(2)
   End If

Next
End With

End Sub

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

MIND = BLOWN.

That worked exactly how I pictured it working. Thank you!

 

[My Aswer Is This]

Survival.

I discovered one mistake in my script.
Try this script instead:

Private Sub Worksheet_Change(ByVal Target As Range)
'Version 2
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1

If Target.Value = "Sold" Then
Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

 

[survivalbloke]

Survival.

I discovered one mistake in my script.
Try this script instead:

Private Sub Worksheet_Change(ByVal Target As Range)
'Version 2
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1

If Target.Value = "Sold" Then
Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

Thank you. Funny you would post this, because I was just coming back here to tell you that any time I modify the B column, the line disappears! But, it looks like your new code fixed it. Thanks again!

 

[My Aswer Is This]

Sorry about that. I'm not perfect yet.

Thank you. Funny you would post this, because I was just coming back here to tell you that any time I modify the B column, the line disappears! But, it looks like your new code fixed it. Thanks again!

 

[tropiqz]

Survival.

I discovered one mistake in my script.
Try this script instead:

Private Sub Worksheet_Change(ByVal Target As Range)
'Version 2
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1

If Target.Value = "Sold" Then
Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

Hi sorry to open this up again but I am doing a similar process, the above works for me but I would like to add another status to "Sold" that follows the same code. For this example we can use "Cancelled", I have been trying "Sold" Or "Cancelled" and copying the same if sequence but replacing Sold with Cancelled however still not working. Any suggestions?

Much appreciated

 

[My Aswer Is This]

Assuming you want to us Sold or Cancelled

And always copy to sheet named Sold
Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  8/28/2018  10:48:41 AM  EDT
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Sold").Cells(Rows.Count, "B").End(xlUp).Row + 1
If Target.Value = "Sold" Or Target.Value = "Cancelled" Then
Rows(Target.Row).Copy Destination:=Sheets("Sold").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

Or do you mean if Sold copy to sheet named Sold and if Cancelled copy to sheet names Cancelled