VBA moving rows

[rolfet]

hi all,

I am trying to get rows to move from "active" Sheet to "complete" sheet on the attached file once column "J" has been sent to "complete".

for the life of me i can not get it to work and as its a moving sheet thats updated daily i want it to move rows from one sheet to another so it only shows live jobs.

can anyone help me with the code as i tried using the below and cant get it to work?

Private Sub Worksheet_Change(ByVal Target As Range)

' Check to see only one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Check to see if entry is made in column B after row 5 and is set to "Yes"
If Target.Column = 10 And Target.Row > 2 And Target.Value = "Complete" Then
Application.EnableEvents = False
' Copy columns B to I to complete sheet in next available row
Range(Cells(Target.Row, "B"), Cells(Target.Row, "K")).Copy Sheets("Complete").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
End If

End Sub


thanks for any help in advance

 

[Ottsel]

Give this a try. Make sure the code is on the "Active" sheet.

Also, I assume you also have data in column A, correct? I did an example and if column A is Blank, then this code will need to be adjusted.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsComplete As Worksheet
    Dim NextRow As Long

    If Target.CountLarge > 1 Then Exit Sub

    If Target.Column = 10 And Target.Row > 1 And Target.Value = "Complete" Then
        Application.EnableEvents = False

        Set wsComplete = ThisWorkbook.Sheets("Complete")
        NextRow = wsComplete.Cells(wsComplete.Rows.Count, "A").End(xlUp).Row + 1

        With Target.EntireRow
            .Range("A1:K1").Copy wsComplete.Cells(NextRow, "A")
            .Delete
        End With
        
        Application.EnableEvents = True
    End If
End Sub

 

[jolivanes]

Another way to try on a copy of your workbook.

Sub Or_Maybe_So()
If Not Application.CountIf(Columns(9), "Complete") = 0 Then
Application.ScreenUpdating = False
With Sheets("Sheet2").UsedRange
    .AutoFilter Field:=9, Criteria1:="Complete"
    With .Offset(1, 0).EntireRow.SpecialCells(xlCellTypeVisible)
        .Copy Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, 1).End(xlUp).Offset(1)
        .Delete (xlShiftUp)
    End With
    .AutoFilter
End With
Application.ScreenUpdating = True
End If
End Sub

The picture shows it to be column 9 so that's what I used.
Change as required.

 

[rolfet]

Give this a try. Make sure the code is on the "Active" sheet.

hi, this works by moving the data from the active sheet onto complete which is amazing. however, when i go onto complete sheet is pastes over the information on row 2 rather than adding each new data to a new line. if that makes sense? for eg when i sent to complete it goes into row 2 on complete sheet then when i set another to complete on the active sheet, rather than going to row 3 then 4 then 5 etc it re-write row 2.

 

[Ottsel]

hi, this works by moving the data from the active sheet onto complete which is amazing. however, when i go onto complete sheet is pastes over the information on row 2 rather than adding each new data to a new line. if that makes sense? for eg when i sent to complete it goes into row 2 on complete sheet then when i set another to complete on the active sheet, rather than going to row 3 then 4 then 5 etc it re-write row 2.

Hmmm, I think I understand. Let's try this, change this:

NextRow = wsComplete.Cells(wsComplete.Rows.Count, "A").End(xlUp).Row + 1

to

NextRow = wsComplete.Cells(wsComplete.Rows.Count, 1).End(xlUp).Row + 1

Let me know if that works.

 

[rolfet]

Hmmm, I think I understand. Let's try this, change this:

NextRow = wsComplete.Cells(wsComplete.Rows.Count, "A").End(xlUp).Row + 1

to

NextRow = wsComplete.Cells(wsComplete.Rows.Count, 1).End(xlUp).Row + 1

Let me know if that works.

i've change the code to suit but for some reason its stopped working altogether? to clarify i dont have any data in column A the data is between B to K starting from row 2 i have attached a clearer picture. Apologies!

 

[jolivanes]

Put code in "Active" Sheet module.
Check references and spelling. Change where required.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, rng As Range, c As Range
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Worksheets("Active")
Set wsC = Worksheets("Complete")
lr = wsA.Cells(wsA.Rows.Count, 10).End(xlUp).Row
Set rng = wsA.Range("J2:J" & lr)
If Target.Column = 10 Then
    For Each c In rng
        If c.Value = "Complete" Then c.Offset(, -8).Resize(, 10).Copy wsC.Cells(wsC.Rows.Count, 2).End(xlUp).Offset(1)
    Next c
End If
End Sub

If you want it pasted in Column A in Complete Sheet, Change the 2 to a 1 like so here.

wsC.Cells(wsC.Rows.Count, 1).End(xlUp).Offset(1)

 

[jolivanes]

If the Cells need deleting, change this line

If c.Value = "Complete" Then c.Offset(, -8).Resize(, 10).Copy wsC.Cells(wsC.Rows.Count, 2).End(xlUp).Offset(1)

to these lines

If c.Value = "Complete" Then
With c.Offset(, -8).Resize(, 10)
.Copy wsC.Cells(wsC.Rows.Count, 2).End(xlUp).Offset(1)    '<---- or (wsC.Rows.Count, 1) to paste in Column A
.Delete Shift:=xlUp
End With

 

[Ottsel]

i've change the code to suit but for some reason its stopped working altogether? to clarify i dont have any data in column A the data is between B to K starting from row 2 i have attached a clearer picture. Apologies!

Apologies for the delay - I had matters to attend to. I see this post still hasn't been solved, so I assume you're still having this issue.

I put together a test. I have the following on the Active sheet:

Test File.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1		Date	Trailer numbe-	Location	Vendor	DTC Fitr	Label	Status	Initi	Job Comple	Additional Comments
2		8/7/2024	46701-20	XPOLogistics GU 5DP	NOR25	Ye s	Yes	Sent	JHB
3		18/07/2024	46715-20	Great Bear Distribution	ABS02	Yes	Yes	Sent	JH8
4		17/07/2024	45921-19	Fleetcare	FLE02	No	No	Sent			MH is waiting on Ant sending Pic & DTC
5		17/07/2024	47891-22	xpo	NOR25	Yes	Yes	Sent	JHB		awaiting ECU to be fit so SAF can collect old Unit
6		12/7/2024	46672-20	Avonmouth Truck and Trailer	AVOOI	Yes	Yes	Sent	JHB
7		16/07/2024	46762-20	Wincanton Bristol BS20 ONE	AVOOI	No	No	Waiting on OTC & Pics	DMCQ		Waiting on DTC& Pics.
8		8/7/2024	46410-20	Naylors Barnsley S75 4AD	HOEOI	Yes	Yes	Need to Replenish Hoeys	DMCQ		Hoey's oingtofittheir own and we can re lenish
9		9/7/2024	47150-21	M&S Bradford BD5 8LZ	JOS02	Yes	Yes	Got from EMS Dewsbu	DMCQ
10		9/7/2024	46210-20	Law Haydock WAII 9SZ	81302	Ye s	Yes	Sent	DMCQ
11		8/7/2024	45871-19	AS Commercials Barnsley	RMMOI/ASCOI	Yes	Yes	Sent	DMCQ
12		8/7/2024	46521-20	Aegus Newcastle	JOS02	Ye s	Yes	Sent	DMCQ
13		9/7/2024	61068-20	KCS sittingbourne	KCS02	Ye s	Yes	Sent	DMCQ
14		10/22/2024	46658-20	Truckrite Bristol	TRU26	Yes	Yes	sent	JHB
15
16
17
18
19
20
Active

I did 3 random tests within my table and selected 3 to type "Complete" on. They all 3 transferred over to the Complete sheet as follows:

Test File.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1		Date	Trailer numbe-	Location	Vendor	DTC Fitr	Label	Status	Initi	Job Comple	Additional Comments
2		7/7/2024	31656-18	TRUCKERS REST WS11 ISF	DOC02	Yes	Yes	Bought from EMS as roadside	JHB	Complete
3		18/07/2024	46209-20	Law Haydock WAII 9SZ	BIB02	Yes	Ye s	Sent	OMCQ	Complete
4		2/7/2024	46680-20M	Great Bear Distribution	HIL06	Ye s	Yes	sent	MG	Complete
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Complete

Here is the code that's insert onto the (Active) sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsComplete As Worksheet
    Dim tblComplete As ListObject
    Dim NextRow As ListRow
    
    If Target.CountLarge > 1 Then Exit Sub
    
    If Target.Column = 10 And Target.Row > 1 And Target.Value = "Complete" Then
        Application.EnableEvents = False
        
        Set wsComplete = ThisWorkbook.Sheets("Complete")
        Set tblComplete = wsComplete.ListObjects(1)
        
        Set NextRow = tblComplete.ListRows.Add
        
        With Target.EntireRow
            tblComplete.ListRows(NextRow.Index).Range.Columns(1).Resize(, 10).Value = .Range("B1:K1").Value
            .Delete
        End With
        
        Application.EnableEvents = True
    End If
End Sub

Hopefully 3rd times the charm!

 

[rolfet]

Apologies for the delay - I had matters to attend to. I see this post still hasn't been solved, so I assume you're still having this issue.

I put together a test. I have the following on the Active sheet:

Test File.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1		Date	Trailer numbe-	Location	Vendor	DTC Fitr	Label	Status	Initi	Job Comple	Additional Comments
2		8/7/2024	46701-20	XPOLogistics GU 5DP	NOR25	Ye s	Yes	Sent	JHB
3		18/07/2024	46715-20	Great Bear Distribution	ABS02	Yes	Yes	Sent	JH8
4		17/07/2024	45921-19	Fleetcare	FLE02	No	No	Sent			MH is waiting on Ant sending Pic & DTC
5		17/07/2024	47891-22	xpo	NOR25	Yes	Yes	Sent	JHB		awaiting ECU to be fit so SAF can collect old Unit
6		12/7/2024	46672-20	Avonmouth Truck and Trailer	AVOOI	Yes	Yes	Sent	JHB
7		16/07/2024	46762-20	Wincanton Bristol BS20 ONE	AVOOI	No	No	Waiting on OTC & Pics	DMCQ		Waiting on DTC& Pics.
8		8/7/2024	46410-20	Naylors Barnsley S75 4AD	HOEOI	Yes	Yes	Need to Replenish Hoeys	DMCQ		Hoey's oingtofittheir own and we can re lenish
9		9/7/2024	47150-21	M&S Bradford BD5 8LZ	JOS02	Yes	Yes	Got from EMS Dewsbu	DMCQ
10		9/7/2024	46210-20	Law Haydock WAII 9SZ	81302	Ye s	Yes	Sent	DMCQ
11		8/7/2024	45871-19	AS Commercials Barnsley	RMMOI/ASCOI	Yes	Yes	Sent	DMCQ
12		8/7/2024	46521-20	Aegus Newcastle	JOS02	Ye s	Yes	Sent	DMCQ
13		9/7/2024	61068-20	KCS sittingbourne	KCS02	Ye s	Yes	Sent	DMCQ
14		10/22/2024	46658-20	Truckrite Bristol	TRU26	Yes	Yes	sent	JHB
15
16
17
18
19
20
Active

I did 3 random tests within my table and selected 3 to type "Complete" on. They all 3 transferred over to the Complete sheet as follows:

Test File.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1		Date	Trailer numbe-	Location	Vendor	DTC Fitr	Label	Status	Initi	Job Comple	Additional Comments
2		7/7/2024	31656-18	TRUCKERS REST WS11 ISF	DOC02	Yes	Yes	Bought from EMS as roadside	JHB	Complete
3		18/07/2024	46209-20	Law Haydock WAII 9SZ	BIB02	Yes	Ye s	Sent	OMCQ	Complete
4		2/7/2024	46680-20M	Great Bear Distribution	HIL06	Ye s	Yes	sent	MG	Complete
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Complete

Here is the code that's insert onto the (Active) sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsComplete As Worksheet
    Dim tblComplete As ListObject
    Dim NextRow As ListRow
   
    If Target.CountLarge > 1 Then Exit Sub
   
    If Target.Column = 10 And Target.Row > 1 And Target.Value = "Complete" Then
        Application.EnableEvents = False
       
        Set wsComplete = ThisWorkbook.Sheets("Complete")
        Set tblComplete = wsComplete.ListObjects(1)
       
        Set NextRow = tblComplete.ListRows.Add
       
        With Target.EntireRow
            tblComplete.ListRows(NextRow.Index).Range.Columns(1).Resize(, 10).Value = .Range("B1:K1").Value
            .Delete
        End With
       
        Application.EnableEvents = True
    End If
End Sub

Hopefully 3rd times the charm!

thank you for taking the time to look at this for me. For some reason the code wont work for me. I have opened a new workbook and laid it out from B to K as above and saved it as macro enabled, copied and pasted the above code however it still doesn't work for me? is there a way you can send me your test file and i can save and re-use that one? sorry for being a pain!!