Macro to move a row based on a condition

Kyle310

New Member
Joined
Feb 12, 2009
Messages
15
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.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try this: right click the Roster sheet's tab, select View Code and paste in

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 4 Then 'D - change to suit
    If Target.Value <> "" Then
        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
        End With
        Application.EnableEvents = True
    End If
End If
End Sub

Change the line in red so it references the Discharge Date column number.

Now when you enter a discharge date the row will be transferred to the Discharges sheet.
 
Upvote 0
Ok, the Discharge Date column is AA, so here is what I changed the line in red to:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = AA Then 'D - change to suit
If Target.Value <> "" Then
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
End With
Application.EnableEvents = True
End If
End If
End Sub

I'm pretty sure I did it wrong. Thank you for the help!
 
Upvote 0
It needs to be

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 27 Then
    If Target.Value <> "" Then
        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
        End With
        Application.EnableEvents = True
    End If
End If
End Sub

:eek: On further thought, you need to ensure that your sort macro doesn't cause this code to be run. To do this add the following line in your code before the sort is done

Code:
Application.EnableEvents = False

Then after the sort

Code:
Application.EnableEvents = True
 
Upvote 0
Alright, I put the two lines before and after the sort(after figuring out the unhide command). It now looks like this:

Sub alpha()
'
' alpha Macro
' Macro recorded 3/4/2009 by WOLF3
'
' Application.EnableEvents = False
Rows("2:149").Select
ActiveSheet.Unprotect
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.ScrollRow = 2
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
End Sub



Then I replaced AA with 27.

Nothing happend when I put a date in as 3/4, but when I typed in 3/4/09 it gave me an error that said the script was out of range. I clicked on DeBug, and it showed this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 27 Then
If Target.Value <> "" Then
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
End With
Application.EnableEvents = True
End If
End If
End Sub

The LR = Sheets("Discharge").Range("A" & LR + 2) line is highlighted yellow with an arrow to the left pointing at it.

Again, I apologize for not getting this right.
 
Upvote 0
Hold the Phone!!

My wife walked in and noticed that I had spelled the Discharge tab wrong!

It seems to be working right now! You are awesome. Let me try this out a couple of times, but this is great. I have to figure out how to implement this on like 15 shared workbooks now, but this will save an unbeleivable amount of time.
 
Upvote 0
Is the discharge sheet actually called Discharge? No leading or trailing spaces?
 
Upvote 0
It is now, I had actually spelled it Dischrge. I always seem to make those kinds of mistakes! Thank you so much, you have no idea.

Now I just have to figure out how to get both of these into everybody's shared files.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top