Move row to original sheet using VBA

[ThomasSA98]

Hi everyone

I have an excel workbook with projects listed.

I have a column that gets manually updated from an dropdown with the values "Identify, Analyze, Implementation, Effectiveness check, Done". Once it is "Done" it indicates as Project completed.

I want the sheet to automatically move the entire row of the completed project to a sheet in the same work book called 3C Done and remove the row from the sheet with the projects in progrees sheet. I use the VBA code for this:

Private Sub Worksheet_Change(ByVal Target As Range)

'Subscribe to youtube.com/excel10tutorial

Dim Z As Long

Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call MoveBasedOnValue

End If

Next

Application.EnableEvents = True

End Sub


But i also want, that if I accidentally press "Done", then i will in the sheet "3C Done" press for example "Analyze" and then it is supposed to go back again. But i cant figure it out, and i really need your help to this!

Looking forward to your help

 

[Joe4]

Welcome to the Board!

I don't see where you code is checking for the value of "DONE". It looks to me like it is running on any change to column E instead of just limiting it to the value of "DONE".

Also, instead of creating another process to fix accidental settings, why not add a verification check instead, i.e.

    Dim chk
    chk = MsgBox("You selected 'DONE', are you sure that you want to move this data row?", vbYesNo, "VERIFY DATA MOVE")
    If chk = vbYes Then
        Call MoveBasedOnValue
    Else
        MsgBox "Move cancelled"
    End If

 

[ThomasSA98]

Welcome to the Board!

I don't see where you codee is checking for the value of "DONE". It looks to me like it is running on any change to column E instead of just limiting it to the value of "DONE".

Also, instead of creating another process to fix accidental settings, why not add a verification check instead, i.e.

    Dim chk
    chk = MsgBox("You selected 'DONE', are you sure that you want to move this data row?", vbYesNo, "VERIFY DATA MOVE")
    If chk = vbYes Then
        Call MoveBasedOnValue
    Else
        MsgBox "Move cancelled"
    End If

Hi Joe4. First of all, thanks for helping!

Can i send you my file, and then you can look into it?

Or maybe give me another code to use?

 

[Joe4]

It would be better if you could post samples of your data using the tool mentioned below, as I cannot download files from my current location (script workforce security policy).

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Also, please post the VBA code behind your "MoveBasedOnValue" procedure.

 

[ThomasSA98]

HI again Joe4

This is from my "3C" sheet:

udkast til 3c ark v.2.xlsm
	A	B	C	D	E
1	Area	Owner	Concern	Date initiated	Status
2	t1	abc	Print issue M&D	01-07-2022	Effectiveness check
3	t2	bcd	Puck falder af conveyor bælte	20-06-2022	Effectiveness check
4	t3	efg	Skifteregister forsvinder	06-07-2022	Effectiveness check
5	t4	hij	3C på Barcode Reject Casepacker Pack 3	01-09-2022	Analyze
6	t5	klm	FGM Intermidiate Stager	01-07-2022	Implementation
7	t6	nop	Testmaskinen på P4	01-01-2022	Effectiveness check
8	t7	rst	FG i intermediate kølerum	01-09-2022	Analyze
9	t8	uvxy	Italy stickers	01-06-2022	Effectiveness check
3C

Cells with Data Validation
Cell	Allow	Criteria
E1:E9	List	='dropdown '!$A$1:$A$5

This is from my "3C Done" sheet:

udkast til 3c ark v.2.xlsm
	A	B	C	D	E
1	Area	Owner	Concern	Date initiated	Status
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
3C Done

Cells with Data Validation
Cell	Allow	Criteria
E1	List	='dropdown '!$A$1:$A$5

The VBA codes i am using in the "3C" sheet is this:


Private Sub Worksheet_Change(ByVal Target As Range)

'Subscribe to youtube.com/excel10tutorial

Dim Z As Long

Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call MoveBasedOnValue

End If

Next

Application.EnableEvents = True

End Sub


I also have this VBA code in the Module1:


Sub MoveBasedOnValue()

'Created by Excel 10 Tutorial

Dim xRg As Range

Dim xCell As Range

Dim A As Long

Dim B As Long

Dim C As Long

A = Worksheets("3C").UsedRange.Rows.Count

B = Worksheets("3C Done").UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(Worksheets("3C Done").UsedRange) = 0 Then B = 0

End If

Set xRg = Worksheets("3C").Range("E1:E" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Value) = "Done" Then

xRg(C).EntireRow.Copy Destination:=Worksheets("3C Done").Range("A" & B + 1)

xRg(C).EntireRow.Delete

If CStr(xRg(C).Value) = "Done" Then

C = C - 1

End If

B = B + 1

End If

Next

Application.ScreenUpdating = True

End Sub

 

[Joe4]

OK, if the only purpose of both of those blocks of code is to move lines when column E is set to "Done", I think you have way more code than you need.
I think it can all be accomplished with this one "Worksheet_Change" event procedure, which will even add in that confirmation I mentioned.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim chk

'   Exit if multiple cells updated at once
    If Target.CountLarge > 1 Then Exit Sub
    
'   See if update made to column E and value is set to "Done"
    If Target.Column = 5 And Target.Value = "Done" Then
'       Confirm they really want to move data
        chk = MsgBox("You selected 'DONE', are you sure that you want to move this data row?", vbYesNo, "VERIFY DATA MOVE")
        If chk = vbYes Then
            Application.EnableEvents = False
'           Move row of data to "3C Done" sheet
            Rows(Target.Row).Copy Sheets("3C Done").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'           Delete row
            Rows(Target.Row).Delete
            Application.EnableEvents = True
        Else
            MsgBox "Please update column E to the proper value", vbOKOnly, "ROW NOT MOVED!"
        End If
    End If

End Sub

 

[ThomasSA98]

Hi Joe4.

It works very well!!

Now my question is:
If now the other persons using this workbook press yes in the checkbox and it was supposed to be no, could you do a smart VBA code to move it back to "3C"?

Thank you so much for your help btw!!

 

[Joe4]

Hi Joe4.

It works very well!!

Now my question is:
If now the other persons using this workbook press yes in the checkbox and it was supposed to be no, could you do a smart VBA code to move it back to "3C"?

Thank you so much for your help btw!!

Well, the hope was if we add that confirmation, it should catch that (so they would need to really make 2 mistakes in order for it to be moved erroneously)!
That should be so rare, that a simple manual copy/paste delete should clean it up (and if they have to do that a few times, maybe they will be a little more careful!)

However, if you want a procedure to move it back, I would recommend adding a new Status Code called "Move Back", and taking a copy of the Worksheet_Change event procedure code from the "3C" sheet and pasting it in the "3C Done" sheet and just change this line:

    If Target.Column = 5 And Target.Value = "Done" Then

to this:

    If Target.Column = 5 And Target.Value = "Move Back" Then

and then change this line:

            Rows(Target.Row).Copy Sheets("3C Done").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

to this:

            Rows(Target.Row).Copy Sheets("3C").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

and it will move it back (though it will be to the bottom of the "3C" sheet, because Excel will have no idea what line it originally came from before being deleted).

 

[ThomasSA98]

Thank you so much Joe.

This thread really helped me a lot, and also made me smarter!!!

 

[Joe4]

You are welcome.
Glad I was able to help!