Automatically move rows from one table to another table based on cell data

[Cgavenas]

Hi all,

I have a workbook with three tables, all housed on separate sheets. The tables are named: "Open", "Won", & "Lost". (Sheets are named the same as their corresponding table)
I would like to automatically move the row from the Open table to either the Won table or the Lost table based on the status selected. In the column titled "Status", each row has a data validation drop-down selection of "Open", "Won" or "Lost". Once a row is selected as "Won" or "Lost" I would like it moved to the bottom of its corresponding table and the row to be deleted from the "Open" table.

I am new to VBA but from what I have gathered from googling/researching I believe this will need an Event Procedure VBA code for my "Open" sheet.

Please let me know if you need any other information.
Thanks in advance for your time!

 

[kevin9999]

A copy of your Open table would be very useful. Please use the XL2BB add in to provide the sample.

 

[Cgavenas]

Of course! Apologies I didn't add in the beginning.

Quote Log - BM.xlsm
	A	B	C	D	E	F
1	RFQ Name	Customer Name	Follow up Date	Amount	Quote Number(s)	Status
2	test	customer test	10/3/2023	$45,345.00	1964654	Open
3	test	customer test	10/3/2023	$103.00	1964654	Open
4	test	customer test	10/3/2023	$5,373.00	1964654	Open
5	test	customer test	10/3/2023	$7,878.00	1964654	Open
6	test	customer test	10/3/2023	$54,613.00	1964654	Open
7	test	customer test	10/3/2023	$9,823.00	1964654	Open
8	test	customer test	9/5/2023	$1,000.00	1964654	Open
9	test	customer test	10/3/2023	$1,000.00	1964654	Open
10	test	customer test	8/22/2023	$100,000.00	1964654	Open
11	test	customer test	10/3/2023	$5,620.00	1964654	Open
12	test	customer test	10/3/2023	$16,558.00	1964654	Open
13	test	customer test	10/3/2023	$7,894.00	1964654	Open
14	test	customer test	10/3/2023	$45,678.00	1964654	Open
15	test	customer test	11/11/2023	$53,751.00	1964654	Open
16	test	customer test	10/3/2023	$2,456.00	1964654	Open
17	test	customer test	10/12/2023	$7,878.00	1964654	Open
18	test	customer test	10/4/2023	$783.00	1964654	Open
19	test	customer test	10/3/2023	$8,678.00	1964654	Open
20	test	customer test	10/12/2023	$248.00	1964654	Open
21	test	customer test	10/3/2023	$7,867.00	1964654	Open
22	test	customer test	11/11/2023	$562.00	1964654	Open
23	test	customer test	10/12/2023	$8,956.00	1964654	Open
24	test	customer test	10/3/2023	$16,546,547.00	1964654	Open
25	test	customer test	10/3/2023	$3,858.00	1964654	Open
26	test	customer test	10/3/2023	$1,852.00	1964654	Open
27	test	customer test	10/3/2023	$15,236.00	1964654	Open
28	test	customer test	10/3/2023	$965.00	1964654	Open
29	test	customer test	10/2/2023	$1,234.00	1964654	Open
30	test	customer test	10/31/2023	$6,541.00	1964654	Open
Open

Cells with Data Validation
Cell	Allow	Criteria
F2:F30	List	Open,Won,Lost

Quote Log - BM.xlsm
	A	B	C	D	E	F	G
1	RFQ Name	Customer Name	Follow up Date	Amount	Quote Number(s)	Status	Sales Order
2
Won

Quote Log - BM.xlsm
	A	B	C	D	E	F	G
1	RFQ Name	Customer Name	Follow up Date	Amount	Quote Number(s)	Status	Reason
2
Lost

 

[kevin9999]

This might take a few goes to get right, but here's a starting point. Tables are always a bit tricky when it comes to formatting. Try the following in the sheet code area of the "Open" sheet (right click the sheet tab name, select View Code, paste the code in the window that appears on the right of screen). Save the file as macro-enabled, and try it on a copy of your file first.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("F:F"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Dim s As String, i As Long
        s = Target.Value2
        If s <> "Open" Then
            Worksheets(s).ListObjects(s).ListRows.Add
            i = Worksheets(s).ListObjects(s).ListRows.Count
            Worksheets(s).ListObjects(s).DataBodyRange(i, 1).Resize(1, 6).Value = _
            Range("A" & Target.Row).Resize(1, 6).Value
            If Worksheets(s).ListObjects(s).DataBodyRange(1, 1) = "" Then _
            Worksheets(s).ListObjects(s).ListRows(1).Delete
            Me.ListObjects("Open").ListRows(Target.Row - 1).Delete
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Cgavenas]

Hi kevin9999, apologies for the delay in responding.
I tested various options with the code you sent, and it works perfectly!
Thank you for the help and your time!

I did do some formatting to give each sheet a facelift after the fact but when I added in a few columns/rows I think I threw things off.
I updated the column range "F:F" to "G:G" and changed the Value Range "A" to "B" but when I test the code after that it will move the row to the appropriate table, but it will delete a different row.

Do you mind reviewing the below and seeing if you can help me update based on my new data?
Apologies in advance for the back and forth!

Quote Log - BM Test.xlsm
	A	B	C	D	E	F	G	H
1
2
3		QUOTE LOG - OPEN
4
5		RFQ NAME	CUSTOMER NAME	FOLLOW UP DATE	AMOUNT	QUOTE NUMBER(S)	STATUS
6		test	customer test	10/3/2023	$5,373.00	1964654	Open
7		test	customer test	10/3/2023	$7,878.00	1964654	Open
8		test	customer test	10/3/2023	$54,613.00	1964654	Open
9		test	customer test	10/3/2023	$9,823.00	1964654	Open
10		test	customer test	11/11/2023	$53,751.00	1964654	Open
11		test	customer test	10/3/2023	$2,456.00	1964654	Open
12		test	customer test	10/12/2023	$7,878.00	1964654	Open
13		test	customer test	10/4/2023	$783.00	1964654	Open
14		test	customer test	10/3/2023	$7,867.00	1964654	Open
15		test	customer test	11/11/2023	$562.00	1964654	Open
16		test	customer test	10/12/2023	$8,956.00	1964654	Open
17		test	customer test	10/3/2023	$16,546,547.00	1964654	Open
18		test	customer test	10/3/2023	$3,858.00	1964654	Open
19		test	customer test	10/3/2023	$1,852.00	1964654	Open
20		test	customer test	10/3/2023	$15,236.00	1964654	Open
21		test	customer test	10/3/2023	$965.00	1964654	Open
22		test	customer test	10/2/2023	$1,234.00	1964654	Open
23		test	customer test	10/31/2023	$6,541.00	1964654	Open
24
25
Open

Cells with Data Validation
Cell	Allow	Criteria
G6:G23	List	Open,Won,Lost

Quote Log - BM Test.xlsm
	A	B	C	D	E	F	G	H	I
1
2
3		QUOTE LOG - WON
4
5		RFQ NAME	CUSTOMER NAME	FOLLOW UP DATE	AMOUNT	QUOTE NUMBER(S)	STATUS	SALES ORDER
6
7
Won

Cells with Data Validation
Cell	Allow	Criteria
G6	List	Open,Won,Lost

Quote Log - BM Test.xlsm
	A	B	C	D	E	F	G	H	I
1
2
3		QUOTE LOG - LOST
4
5		RFQ NAME	CUSTOMER NAME	FOLLOW UP DATE	AMOUNT	QUOTE NUMBER(S)	STATUS	REASON
6
7
Lost

Cells with Data Validation
Cell	Allow	Criteria
G6	List	Open,Won,Lost

 

[kevin9999]

Just needed a bit of tweaking, please try the following amended code on a copy of your workbook:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("G:G"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Dim s As String, i As Long
        s = Target.Value2
        If s <> "Open" Then
            Worksheets(s).ListObjects(s).ListRows.Add
            i = Worksheets(s).ListObjects(s).ListRows.Count
            Worksheets(s).ListObjects(s).DataBodyRange(i, 1).Resize(1, 6).Value = _
            Range("B" & Target.Row).Resize(1, 6).Value
            If Worksheets(s).ListObjects(s).DataBodyRange(1, 1) = "" Then _
            Worksheets(s).ListObjects(s).ListRows(1).Delete
            Me.ListObjects("Open").ListRows(Target.Row - 5).Delete
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Cgavenas]

Perfect! That was exactly what I needed.
Thank you so much for your time and help!

 

[kevin9999]

Perfect! That was exactly what I needed.
Thank you so much for your time and help!

Happy to help. And welcome to the forum

 

[PGI_Help]

@kevin9999 What if I only wanted to take the contents of 1 cell from the open tab, let's say column F (Quote Number), and populate that cell data in column F of the Won or Lost tab. The difference is not taking the entire row, just the data in 1 cell?

 

[kevin9999]

In that case, you would change this line of code:

Worksheets(s).ListObjects(s).DataBodyRange(i, 1).Resize(1, 6).Value = _
Range("B" & Target.Row).Resize(1, 6).Value

To this:

Worksheets(s).ListObjects(s).DataBodyRange(i, 5).Value = _
Range("F" & Target.Row).Value

Assuming of course that your table layout is exactly the same as it is in this thread. If your table(s) and sheet layouts are significantly different, then I suggest you start a new thread.
Hope this helps