Create VBA code to move a row of data based on a selection in a drop down list

[Doc56]

Hi all,

I have a sheet that contains the master data (Sheet called "Workplan"). I have also created a sheet called "Job Analysis".

In the Job Analysis sheet I have created a drop down list and what I am hoping is to get code that will copy rows of data based on the condition/selection of the drop down list.
The criteria listed in the drop down list are: "Completed", "In-Progress", "On-Hold".

Therefore, as an example: if I select "Completed" from the drop down I want all the rows that have a job status listed as: "Completed" in the Workplan sheet to populate in the Job Analysis sheet

Workplan Sheet:

Job Analysis Sheet:

The work Plan sheet acts as the master and new rows of data will be added so I am hoping the code will allow for new data to filter through based on the condition in the drop down selection.
Sorry if I am unclear. Also I am not using Microsoft 365 or Excel 2021 so cannot use the new "Filter" function which would be perfect for this scenario.

 

[kevin9999]

Please use the XL2BB add in to provide a sample we can work with. You can't tell from your image what rows/columns any of the data is in. Also, that looks like a table on the Workplan sheet - is it, and what is it called?

 

[Doc56]

Please use the XL2BB add in to provide a sample we can work with. You can't tell from your image what rows/columns any of the data is in. Also, that looks like a table on the Workplan sheet - is it, and what is it called?

Apologies:

Workplan Sheet: - is a table (Table Name: WPLAN)

Construction Jobs.xlsx
	A	B	C	D	E	F	G	H	I	J	K
5
6	Date	HOU job	Constn Job code	RPM Job Number	Address	Details	Number	$AMT	NOTES	Job Status	Date Completed
7	TBC			TBA	8 Kullaroo Close, Kuranda 4881	Demolition			Agreement to be confirmed and signed	In-Progress
8	25/10/22			16479	0/5A/213 Buchan Street, Kowrowa 4881	Replacement of water filters at the water tanks at Kowrowa				In-Progress
9	25/10/22			16478	7/24 Coondoo St, Kuranda 4881	Routine servicing and cleaning of office air conditioners				In-Progress
10	25/10/22			16477	0/40 Coondoo St, Kuranda 4881	Routine servicing and cleaning of office air conditioners			Previously arranged every 6 months	In-Progress
11	20/10/22			16476	0/40 Coondoo St, Kuranda 4881	Executive Office - air conditioner in Leandra's room is not cold				In-Progress
12	20/10/22			16475	34 Rob Veivers Drive, Kuranda 4881	Fence and retaining wall				In-Progress
13	20/10/22			16474	41 Barang Street, Kuranda	Front fence and driveway crossover for vehicle access				In-Progress
14	20/10/22			16473	2/213 Buchan Street, Kowrowa 4881	External tap repairs				In-Progress
15	18/10/22			16472	0/40 Coondoo St, Kuranda 4881	HWS in Executive office kitchen is leaking				In-Progress
Workplan

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
K8:K552	Expression	=+$J8="Completed"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
K7	List	Completed, In-Progress, On-Hold, Cancelled, Quote Requested
J7:J15	List	Completed, In-Progress, On-Hold, Cancelled, Quote Requested

 

[kevin9999]

Apologies:

Workplan Sheet: - is a table (Table Name: WPLAN)

Construction Jobs.xlsx
	A	B	C	D	E	F	G	H	I	J	K
5
6	Date	HOU job	Constn Job code	RPM Job Number	Address	Details	Number	$AMT	NOTES	Job Status	Date Completed
7	TBC			TBA	8 Kullaroo Close, Kuranda 4881	Demolition			Agreement to be confirmed and signed	In-Progress
8	25/10/22			16479	0/5A/213 Buchan Street, Kowrowa 4881	Replacement of water filters at the water tanks at Kowrowa				In-Progress
9	25/10/22			16478	7/24 Coondoo St, Kuranda 4881	Routine servicing and cleaning of office air conditioners				In-Progress
10	25/10/22			16477	0/40 Coondoo St, Kuranda 4881	Routine servicing and cleaning of office air conditioners			Previously arranged every 6 months	In-Progress
11	20/10/22			16476	0/40 Coondoo St, Kuranda 4881	Executive Office - air conditioner in Leandra's room is not cold				In-Progress
12	20/10/22			16475	34 Rob Veivers Drive, Kuranda 4881	Fence and retaining wall				In-Progress
13	20/10/22			16474	41 Barang Street, Kuranda	Front fence and driveway crossover for vehicle access				In-Progress
14	20/10/22			16473	2/213 Buchan Street, Kowrowa 4881	External tap repairs				In-Progress
15	18/10/22			16472	0/40 Coondoo St, Kuranda 4881	HWS in Executive office kitchen is leaking				In-Progress
Workplan

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
K8:K552	Expression	=+$J8="Completed"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
K7	List	Completed, In-Progress, On-Hold, Cancelled, Quote Requested
J7:J15	List	Completed, In-Progress, On-Hold, Cancelled, Quote Requested

Thank you for this. Could you also do the same for the Job Analysis sheet? (Can't tell where that data starts, or which cell has the drop down)

 

[kevin9999]

You'll need to make a couple of changes to the code below: change the sheet name of the Job Analysis sheet, and change the cell address of the dropdown that has "Completed" in it.

Option Explicit
Sub Workplan()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Workplan")
    Set Ws2 = Worksheets("Sheet2")      '<<< Change this to the actual Job Analysis sheet name
    Dim LRow As Long, Status As String
    
    LRow = Ws2.Cells(Rows.Count, 1).End(3).Row + 1
    Status = Ws2.Range("D4").Value      '<<< Change this to the actual cell with the dropdown
    
    With Ws1.ListObjects("WPLAN").Range
        .AutoFilter 10, Status
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Range("A" & LRow)
        .AutoFilter 10
    End With

End Sub

 

[Doc56]

My apologies,

The Job Analysis example:

Construction Jobs.xlsx
	A	B	C	D	E	F	G	H	I	J	K
2			Filter Data Criteria	Completed
3	WORK PLAN
4
5	Date	HOU job	Constn Job code	RPM Job Number	Address	Details	Number	$AMT	NOTES	Job Status	Date Completed
6
7
Job Analysis

Cells with Data Validation
Cell	Allow	Criteria
D2	List	=List!$A$2:$A$5

 

[kevin9999]

No need to apologise, and thank you for providing the requested information. Try this:

Option Explicit
Sub Workplan()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Workplan")
    Set Ws2 = Worksheets("Job Analysis")
    Dim LRow As Long, Status As String
    
    LRow = Ws2.Cells(Rows.Count, 1).End(3).Row + 1
    Status = Ws2.Range("D2").Value
    
    With Ws1.ListObjects("WPLAN").Range
        .AutoFilter 10, Status
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Range("A" & LRow)
        .AutoFilter 10
    End With

End Sub

 

[Doc56]

Hi Kevin,
That is brilliant!

Just in addition, is there VBA code to add a way that by selecting the drop down item it replaces the previous selection data rather than putting it at the bottom of the previous selection.

Example: I run the code on the first drop down selection, say "Completed" and it populates that data, then if I want to select another criteria, say "In-Progress" is there a piece of code to add to wipe the previous selection and replace with the new selection criteria.

Again this is greatly appreciated.

 

[kevin9999]

No problem

Option Explicit
Sub Workplan_2()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Workplan")
    Set Ws2 = Worksheets("Job Analysis")
    Dim LRow As Long, Status As String
    
    LRow = Ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row
    If LRow = 5 Then LRow = 6
    Ws2.Range("A6:K" & LRow).Clear
    
    Status = Ws2.Range("D2").Value
    
    With Ws1.ListObjects("WPLAN").Range
        .AutoFilter 10, Status
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Range("A6")
        .AutoFilter 10
    End With

End Sub

 

[Doc56]

Thanks very much Kevin,

It is perfect and much appreciated.

Cheers
Darren