I have created a worksheet to reflect project status. One of the columns is, surprisingly, "Project Status", which calls from a list of values. One of these values is "Completed".
I have two relevant sheets in the workbook, both with identical column structure: one to reflect projects In Flight, and the second to show Completed projects, so my objective is to implement code which would validate the project status cell (column R), and where the value is "Completed" the entire row will be copied to the Completed sheet and then deleted from the In Flight sheet.
I would also need a reverse solution to allow for human error. So in case the status was updated in error and the row moved, the user could then access the "Completed" tab, change the status back to something else other than "Completed" and then the row would be moved back to the In Flight sheet.
The row to be occupied, in either direction would be the next available empty row.
Hope that makes sense to someone...!
I have tried this, and it appears to do more-or-less what I am trying to achieve, but then Excel freezes! I think it is going into a loop somewhere but cannot locate it.
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Set i = Sheets("InFlight") Set e = Sheets("Completed") Dim d Dim j d = 4 j = 5 Do Until IsEmpty(i.Range("R" & j)) If i.Range("R" & j) = "Completed" Then d = d + 1 e.Rows(d).Value = i.Rows(j).Value i.Rows(j).EntireRow.Delete End If j = j + 1 LoopEnd Sub
1. Code on Data Sheet Module: Assuming the Main Sheet is called Data. if not, change it in line#4 of the last two codes. Remember that this code will only be triggered once you change the status in column R.
Private Sub Worksheet_Change(ByVal Target As Range)If Target.CountLarge > 1 Then Exit SubDim dws As WorksheetDim MoveRow As BooleanOn Error GoTo SkipIf Target.Column = 18 And Target.Row > 1 Then Application.EnableEvents = False Select Case Target.Value Case "InFlight" Set dws = Sheets("InFlight") MoveRow = True Case "Completed" Set dws = Sheets("Completed") MoveRow = True End Select If MoveRow Then Target.EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2) Target.EntireRow.Delete End IfEnd IfSkip:Application.EnableEvents = TrueEnd Sub
Private Sub Worksheet_Change(ByVal Target As Range)If Target.CountLarge > 1 Then Exit SubDim dws As WorksheetSet dws = Sheets("Data") 'The Sheet with Source Data where this Row will be copied back after changing the status backOn Error GoTo SkipIf Target.Column = 18 And Target.Row > 1 Then If Target.Value <> "InFlight" And Target.Value <> "Completed" Then Application.EnableEvents = False Target.EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2) Target.EntireRow.Delete End IfEnd IfSkip:Application.EnableEvents = TrueEnd Sub
Private Sub Worksheet_Change(ByVal Target As Range)If Target.CountLarge > 1 Then Exit SubDim dws As WorksheetSet dws = Sheets("Data") 'The Sheet with Source Data where this Row will be copied back after changing the status backOn Error GoTo SkipIf Target.Column = 18 And Target.Row > 1 Then If Target.Value <> "InFlight" And Target.Value <> "Completed" Then Application.EnableEvents = False Target.EntireRow.Copy dws.Range("A" & Rows.Count).End(3)(2) Target.EntireRow.Delete End IfEnd IfSkip:Application.EnableEvents = TrueEnd Sub
With your permission I'd like to re-open this question and suggest you split points between Roy's first post and mine that you selected. He really does deserve some recognition since he mentioned this first...
Roy thank you very much for this information!
Bill I am new to this game, so no idea how to do that! Looked for a REOPEN function on the site but could not locate this. If I can ask for some direction, I will be happy to split the points.
Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.
1. Code on Data Sheet Module: Assuming the Main Sheet is called Data. if not, change it in line#4 of the last two codes. Remember that this code will only be triggered once you change the status in column R.
Open in new window
2. Code on InFlight Sheet Module:
Open in new window
3. Code on Completed Sheet Module:
Open in new window