Automatically Move Row to Another Sheet Based On Cell Value

[marleymstuhmcke]

Hi all,

Complete VBA newbie here, so any help would be much appreciated!

I am trying to AUTOMATICALLY copy/duplicate a row of data from sheet “Current” to another sheet “Exceeded”.

I have a table of data that I am manually inputting data into every day, to keep on track of all staff’s uniforms. The active sheets are A-L, with unlimited rows (as I will be added to the list every day). The first row of actual data starts at A3.

• Columns G, I & L – I have added a “function” to reflect on the value in the cells next to it. (G3 = 5 – F3). So, each staff member gets a limit of 5 shirts. I put in a calculation so that cells G, I & L reflect on how many they have remaining. Once this limit is exceeded, the cell will go to 0 and is conditionally formatted to turn red (all cells containing 0 value).

I am trying to get a VBA to AUTOMATICALLY duplicate/copy the rows with 0 value into the next tab “Exceed”. So, if G3 is 0 in tab “Current”, the entire row (A-L) will get duplicated/copied into the next tab “Exceed”.

I have attached a photo of my worksheet for reference. If you have any questions, please let me know. I have never used this type of coding before, so I am fish out of water!!

 

[MARK858]

Maybe something like

Sub Filterit()
    Application.ScreenUpdating = False
    
    With Sheets("Current").Range("G2:G" & Sheets("Current").Range("G" & Rows.Count).End(xlUp).Row)
    
        .AutoFilter 1, 0
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy _
        Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilter
        
    End With
       
    Application.ScreenUpdating = True
End Sub

 

[marleymstuhmcke]

Maybe something like

Sub Filterit()
    Application.ScreenUpdating = False
   
    With Sheets("Current").Range("G2:G" & Sheets("Current").Range("G" & Rows.Count).End(xlUp).Row)
   
        .AutoFilter 1, 0
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy _
        Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilter
       
    End With
      
    Application.ScreenUpdating = True
End Sub

Yes! That has worked, but unfortunately it is only picking up the 0 in G column, not I and J aswell.
Thankyou! If I input more data will this also transfer over?

 

[MARK858]

Try the code below on a copy of your workbook..

Sub Filterit2()
    Application.ScreenUpdating = False
 
    With Sheets("Current").Range("A2:L" & Sheets("Current").Range("A" & Rows.Count).End(xlUp).Row)
 
        .AutoFilter 7, 0
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy _
        Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilter
     
        .AutoFilter 9, 0
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy _
        Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilter
     
        .AutoFilter 10, 0
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy _
        Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilter
   
    End With

    With Sheets("Exceeded").Range("A2:L" & Sheets("Exceeded").Range("A" & Rows.Count).End(xlUp).Row)
        .Sort Key1:=.Cells(1), Header:=xlNo
        .Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .Columns(1).SpecialCells(4).EntireRow.Delete
        On Error GoTo 0
    End With
    
    Application.ScreenUpdating = True
End Sub

If I input more data will this also transfer over?

No, you'll have to clear all the data on sheet Exceeded and rerun the code

 

[felixstraube]

Do you need to use VBA? Or could you use a simple formula? Because with Excel 365 (which you have according to your profile) it is very simple:
Convert your data to a table ("Tabla1" in my case) an apply this formula in B14 (or wherever you want your result table):

Libro1
	B	C	D	E	F	G	H	I	J	K	L
3	Date	Name	Department	Where Purchased	Hi Visibility Shirt	Quantity Remaining	Long Trousers	Quantity Remaining2	5 in 1 Jacket	Soft Shell	Quantity Remaining3
4	03/07/2023	Name01	Depot	The Uniform Zone	5	0	5	0	1	1	0
5	03/07/2023	Name02	Depot	The Uniform Zone		5		5	1		1
6	04/07/2023	Name03	Depot	The Uniform Zone	5	0	2	3			2
7	04/07/2023	Name03	Depot	The Uniform Zone	5	0	5	0			2
8	05/07/2023	Name04	Depot	The Uniform Zone		5	2	3			2
9	15/07/2023	Name05	Depot	The Uniform Zone		5	5	0			1
10
11
12
13
14	Date	Name	Department	Where Purchased	Hi Visibility Shirt	Quantity Remaining	Long Trousers	Quantity Remaining2	5 in 1 Jacket	Soft Shell	Quantity Remaining3
15	03/07/2023	Name01	Depot	The Uniform Zone	5	0	5	0	1	1	0
16	04/07/2023	Name03	Depot	The Uniform Zone	5	0	2	3	0	0	2
17	04/07/2023	Name03	Depot	The Uniform Zone	5	0	5	0	0	0	2
18	15/07/2023	Name05	Depot	The Uniform Zone	0	5	5	0	0	0	1
Hoja1

Cell Formulas
Range	Formula
B14:L18	B14	=VSTACK(Tabla1[#Headers], FILTER(Tabla1,Tabla1[Quantity Remaining]*Tabla1[Quantity Remaining2]*Tabla1[Quantity Remaining3]=0))
Dynamic array formulas.

 

[MARK858]

Convert your data to a table ("Tabla1" in my case)

Why does the OP need to convert the data to a table?

 

[felixstraube]

You are right, he doesn't need to. It was more of a suggestion. It's easier, in mho, to work with data, use formulae and maintain you worksheet this way.
But here it is without table:

Libro1
	C	D	E	F	G	H	I	J	K	L	M
3	Date	Name	Department	Where Purchased	Hi Visibility Shirt	Quantity Remaining	Long Trousers	Quantity Remaining2	5 in 1 Jacket	Soft Shell	Quantity Remaining3
4	03/07/2023	Name01	Depot	The Uniform Zone	5	0	5	0	1	1	0
5	03/07/2023	Name02	Depot	The Uniform Zone		5		5	1		1
6	04/07/2023	Name03	Depot	The Uniform Zone	5	0	2	3			2
7	04/07/2023	Name03	Depot	The Uniform Zone	5	0	5	0			2
8	05/07/2023	Name04	Depot	The Uniform Zone		5	2	3			2
9	15/07/2023	Name05	Depot	The Uniform Zone		5	5	0			1
10
11
12
13
14	Date	Name	Department	Where Purchased	Hi Visibility Shirt	Quantity Remaining	Long Trousers	Quantity Remaining2	5 in 1 Jacket	Soft Shell	Quantity Remaining3
15	03/07/2023	Name01	Depot	The Uniform Zone	5	0	5	0	1	1	0
16	04/07/2023	Name03	Depot	The Uniform Zone	5	0	2	3	0	0	2
17	04/07/2023	Name03	Depot	The Uniform Zone	5	0	5	0	0	0	2
18	15/07/2023	Name05	Depot	The Uniform Zone	0	5	5	0	0	0	1
Hoja1

Cell Formulas
Range	Formula
C14:M18	C14	=VSTACK(Hoja1!$C$3:$M$3, FILTER(Hoja1!$C$4:$M$9,Hoja1!$H$4:$H$9*Hoja1!$J$4:$J$9*Hoja1!$M$4:$M$9=0))
Dynamic array formulas.