Macro to move a row based on a condition

[Kyle310]

I tried the Colo's HTML Maker to attach the file, but it's not working for me. I would be more than happy to send this file to make things easier.

Alright, I have a workbook with 3 tabs. The first tab doesn't matter. The second tab is called Roster and the third tab is called Discharged. I have about 15 counselor's that have 30-80 clients on their Roster tab. This becomes very unorganized because they are constantly adding new clients to the bottom of the tab. I recorded a macro that will alphabetize the clients by name (and hopefully keep the information next to the correct name). The other thing that I would like this macro to do is move the entire row onto the Discharge tab when a date for discharge is entered into the "Discharge Date" column.

A couple of important things: First is the information next to the name. If just the names move, all of the info will be for the wrong person. Next is the page itself; if the rows are being cut and pasted into tab 3, tab 2 will eventually run out of rows.

Again, I have a sample file to clarify but could not figure out how to post it. (This may show how dumb I can be, and I have to apologize in advance Thanks for your help.

 

[Kyle310]

This is sweet, and it works. The problem I'm having right now is with protection. Am I going to have to leave the sheets unprotected for this to work?

Man, this is so close! Just a couple of details to figure out. When this is up and running for everybody, you just made me the hero of the office!

On a related note, I work with mental health counselors. I may not know a lot about this kind of stuff, but I seriously have a guy working here who keeps freaking out because all of his "stuff" is gone. I've taught him how to use the scroll bar at least 5 times to get back to where the data is. That's fine with me, but it would really help if this was as fool-proof as possible.

Thanks again!

 

[VoG]

Perhaps

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 27 Then
    If Target.Value <> "" Then
        Me.Unprotect Password:="abc"
        Sheets("Discharge").Unprotect Password:="abc"
        Application.EnableEvents = False
        LR = Sheets("Discharge").Range("A" & Rows.Count).End(xlUp).Row
        With Target.EntireRow
            .Copy Destination:=Sheets("Discharge").Range("A" & LR + 1)
            .Delete
            MsgBox "Record transferred to sheet Discharge", vbInformation
        End With
        Me.Unprotect Password:="abc"
        Sheets("Discharge").Unprotect Password:="abc"
        Application.EnableEvents = True
     End If
End If
End Sub

Change abc to the actual password.

 

[Kyle310]

Perfect!!

You are the man. If you ever need a cool font or something I can handle, I would like to pay you back

 

[Kyle310]

I added this to re-protect the sheets

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 27 Then
If Target.Value <> "" Then
Me.Unprotect Password:="roster"
Sheets("Discharge").Unprotect Password:="roster"
Application.EnableEvents = False
LR = Sheets("Discharge").Range("A" & Rows.Count).End(xlUp).Row
With Target.EntireRow
.Copy Destination:=Sheets("Discharge").Range("A" & LR + 1)
.Delete
MsgBox "Record transferred to sheet Discharge", vbInformation
End With
Me.Unprotect Password:="roster"
Sheets("Discharge").Unprotect Password:="roster"
Application.EnableEvents = True
Sheets("Discharge").Protect Password:="roster"
Sheets("Roster").Protect Password:="roster"
End If
End If
End Sub


It seems to work correctly, did I do that right?

 

[VoG]

Yep - looks correct to me.

 

[Kyle310]

Thanks again. This is a huge help.

 

[Kyle310]

I just realized something. For the unprotect to work, the workbook has to be unshared. Is there a way around this? The only other viable option I see is to instruct the users how to take the share off and then reapply the share after they are finished. But that won't even work because other people might have that document open. Arrrrr!

 

[VoG]

Shared workbooks are not something that I have any great experience of. You might want to start a new thread on this topic.