VBA help - I can't move data to last row of different sheet

[aliecat08]

Complete VBA newbie - 6 years ago, I tried making an Excel workbook to track cases and automatically move cases from "OpenCases" to "ClosedCases" when case status changed to "Closed". I found this code on some site (maybe even here?) and just changed the triggering event to "CLOSED". It does the job of moving the row but it's inserting in the ClosedCases sheet in weird places. Sometimes row 4 sometimes row 3. It's so weird.

I gave up on the project but now we need to use it again so I'm trying to fix the issue. I tried changing the range of the destination row in name manager, but then the code stopped working.

Anyway, I need it tweaked so it automatically transfers the data to the last row available row on "Closed Cases". I also need to sort "ClosedCases" alphabetically, so every time the case is moved from Open to Closed, it should automatically sort the sheet upon closing the workbook.

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range
Set rngDest = Sheet2.Range("rngDest")
' Limit the trap area to range of cells in which completed dates are entered as defined above
If Not Intersect(Target, Sheet1.Range("rngTrigger")) Is Nothing Then
' Only trigger if the value entred is a date or is recognizable as a valid date
     If UCase(Target) = "CLOSED" Then
'Ensure subsequent deletion of 'moved' row does NOT cause the Change Event to run again and get itself in a loop!
        Application.EnableEvents = False
        Target.EntireRow.Select
        Selection.Cut
        rngDest.Insert Shift:=xlDown
        Selection.Delete
' Reset EnableEvents
        Application.EnableEvents = True
    End If
End If
End Sub

NOTE - In the name manager, "rngTrigger" =OpenCases!$G:$G and "rngDest" =ClosedCases!$3:$3. Row 1 has the headers but isn't named.


PLEASE PLEASE HELP!

 

[vcoolio]

Hello Aliecat,

Could you upload a sample of your workbook using the Xl2BB function (noted at the top of any reply box).
It's probably simpler to not use the named ranges in your case.
What column do you want to sort on? Are they surnames in the sort column?

Cheerio,
vcoolio.

 

[aliecat08]

This is my first time using XI2BB. Did it work? In the OpenCases sheet, I want that entire row to move to ClosedCases when the "Status" column is changed to "Settled" or "Dropped" or "Closed". In the ClosedCases sheet, I want it autosorted by the "Last Name" column.

Moving Closed Status to ClosedCases Sheet.xlsm
	A	B	C	D	E	F	G
1	LAST NAME	FIRST NAME	DOL	STATUTE	ATTORNEY(S)	ASSISTANT	STATUS
2	DOE	ALPHA	3/8/2021	3/8/2023	Romeo	Kilo	Pre-lit
3	DOE	BRAVO	4/28/2021	4/28/2023	Romeo	Juliett	Pre-lit
4	DOE	CHARLIE	9/30/2022	9/30/2024	Lima	Papa	Filed
5	DOE	DELTA	9/13/2021	9/13/2023	Lima	Papa	Pre-lit
6	DOE	ECHO	10/18/2020	10/18/2022	Mike	Quebec	Filed
7	DOE	FOXTROT	2/18/2021	2/18/2023	MIke	Quebec	Pre-lit
8	DOE	GOLF	12/1/2022	12/1/2018	Yankee	Uniform	Filed
9	DOE	HOTEL	5/10/2021	5/10/2023	Yankee	Victor	Pre-lit
10	DOE	INDIA	5/19/2021	5/19/2023	Romeo	Whiskey	Settled
11	DOE	INDIA	6/9/2021	6/9/2023	Romeo	Whiskey	Settled
12	PITT	BRAD	1/1/2018	1/1/2020	Lima	Victor
OpenCases

Moving Closed Status to ClosedCases Sheet.xlsm
	A	B	C	D	E	F	G	H
1	LAST NAME	FIRST NAME	DOL	STATUTE	ATTORNEY(S)	ASSISTANT	STATUS	RESOLUTION TYPE
2	SMITH	JOHN	1/29/2021	1/29/2023	Romeo	Whiskey	CLOSED
3	DOE	INDIA	5/19/2017	5/19/2019	Romeo	Whiskey	Closed
4	BRADY TOM	TOM	1/30/2021	1/30/2023	ROMEO	Whiskey	CLOSED
5	DOE	ALPHA	3/8/2017	3/8/2019	Romeo	Kilo	Closed	Settled
6	DOE	BRAVO	4/28/2017	4/28/2019	Romeo	Juliett	Closed	Settled
7	DOE	CHARLIE	9/30/2016	9/30/2018	Lima	Papa	Closed	Settled
8	DOE	DELTA	9/13/2017	9/13/2019	Lima	Papa	Closed	Dropped
9	DOE	ECHO	10/18/2014	10/18/2016	Mike	Quebec	Closed	Settled
10	DOE	FOXTROT	2/18/2017	2/18/2019	MIke	Quebec	Closed	Settled
11	DOE	GOLF	12/1/2016	12/1/2018	Yankee	Uniform	Closed	Dropped
12	DOE	HOTEL	5/10/2017	5/10/2019	Yankee	Victor	Closed	Subbed-Out
13	DOE	INDIA	5/19/2017	5/19/2019	Romeo	Whiskey	Closed	Dropped
ClosedCases

 

[vcoolio]

Hello Aliecat,

Thanks for supplying the sample.

Try the following codes in a copy of your workbook first:-

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns(7)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
        If Target.Value = "Closed" Or Target.Value = "Settled" Or Target.Value = "Dropped" Then
             Target.EntireRow.Copy Sheets("ClosedCases").Range("A" & Rows.Count).End(3)(2)
             Target.EntireRow.Delete
             Sheets("ClosedCases").Columns.AutoFit
        End If
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

The above code should do the copy/pasting task for you once the relevant criteria is typed into the the relevant cell in the Status column. If your Status criteria are selected from a drop down, the code will trigger instantly otherwise, just click away from the cell. The code will also delete the relevant row of data from the OpenCases worksheet once the data transfer is completed.

To implement this code into your workbook:-
- Right click on the OpenCases tab and select "View Code" from the menu that appears.
- In the big white code field that then appears, paste the above code.

The following code will sort your data in the ClosedCases worksheet once the workbook is closed:-

Private Sub Workbook_BeforeClose(Cancel As Boolean)

If Cancel = True Then Exit Sub
Dim wsCC As Worksheet: Set wsCC = Sheets("ClosedCases")

wsCC.[A1].CurrentRegion.Offset(1).Sort wsCC.[A2], 1

End Sub

The code will sort the data 'Ascending' based on Column A.

To implement this code into the ThisWorkbook module:-
- Right click on any tab and select "View Code".
- Over to the left in the Project Explorer, double click on ThisWorkbook.
- In the big white code field that appears, paste the above code.

Close and save the workbook.

I hope that tis helps.

Cheerio,
vcoolio.

 

[aliecat08]

Omg, this was perfect. THANK YOU!!!

Is there a way to do the reverse, in case we mistakenly move a case to ClosedCases sheet. So if the "Status" in "ClosedCases" is changed from "Closed" or "Settled" or "Subbed Out" (it'll be something like "Filed" "Pending" or "Pre-lit" it will move it back to the OpenCases sheet?

And ideally, add a message that pops up before the move that confirms the move. Something like "Are you sure you want to move the case to Closed Cases?" and "Are you sure you want to move the case to Open Cases?"

 

[vcoolio]

Hello Aliecat,

To allow for a message box to pop up prior to any data transfer, change the WorkSheet_Change code to:-

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns(7)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
       
        If Target.Value = "Closed" Or Target.Value = "Settled" Or Target.Value = "Dropped" Then
        If MsgBox("Are you sure that you have selected the correct case to move to Closed Cases?", vbCritical + vbYesNo, "WARNING") = vbYes Then
             Target.EntireRow.Copy Sheets("ClosedCases").Range("A" & Rows.Count).End(3)(2)
             Target.EntireRow.Delete
             Sheets("ClosedCases").Columns.AutoFit
        End If
        End If
       
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

To send data back to the Open Cases worksheet should a case be mistakenly sent to the Closed Cases worksheet, place the following code into the worksheet module of the ClosedCases tab. Implement it as per the instrucrions for the OpenCases worksheet in post #4.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns(8)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
       
        trow = Target.Row
        If Target.Value = "Yes" Then
        If MsgBox("Are you sure that you have selected the correct case to move back to Open Cases?", vbCritical + vbYesNo, "WARNING") = vbYes Then
             Range(Cells(trow, "A"), Cells(trow, "F")).Copy Sheets("OpenCases").Range("A" & Rows.Count).End(3)(2)
             Target.EntireRow.Delete
             Sheets("OpenCases").Columns.AutoFit
        End If
        End If
       
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

I've tried to simplify it for you by using column 8("H") in the Closed Cases worksheet as the criteria column but only using one criteria, "Yes". A message box will pop up asking the User if they want to proceed once "Yes" is entered in a relevant cell. You can use another criteria column for this if you like. Let us know what you think.
Again, the relevant row of data will be deleted from the Closed Cases work sheet once the data is transferred back to the Open Cases worksheet.

Cheerio,
vcoolio.

 

[aliecat08]

OMG OMG OMG!!! You are awesome!!!! Thank you so much!

 

[vcoolio]

You're welcome Aliecat. I'm glad to have been able to assist and thanks for the feed back.

Cheerio,
vcoolio.