Copy, Move and Delete Row, based on Cell Value

D

Domn8r

New Member
Joined
Jun 20, 2009
Messages
19
Office Version
  1. 365
Platform
  1. Windows
I have a spreadsheet (Sheet 1) listing current Work Orders with each work order occuping a seperate row; Column E lists the status of the work order, with the status being chosen from a drop down list.
I would like to have a macro that will copy the entire row and paste into (Sheet 2) when the status is changed to CLOSED, and clear the contents of the cells on Sheet 1.
The aim of this being of course to have all open work orders on sheet 1 and all closed orders on sheet 2.
Hope someone can help me with this
Thanks!!!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
try
to a worksheet module
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("e")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then
    MsgBox "You can not change multiple cells in col.E"
    Application.Undo
Else
    If Target.Value = "CLOSED" Then
        Target.EntireRow.Cut _
        Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2)
        Application.CutCopyMode = False
    End If
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Seiya,
Thanks for the quick reply.
I probably should have given more detail in by original question; I have a colourcoding macro in worksheet module; this seems to be causing a problem when I add the code you supplied.
Sheet 1 is titled `Current Work Orders` and Sheet 2 is Àrchived`.
I messed around with the your code but confess I really dont have enough knowledge to know if I am improving the situation or making it worse!!
I also noticed that when the data is cleared from Sheet 1, the drop list is no longer available in that row.
Sheet 1 looks like this; (some columns are omitted due to personal info)
Current Work Orders


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 107px"><COL style="WIDTH: 36px"><COL style="WIDTH: 206px"><COL style="WIDTH: 84px"><COL style="WIDTH: 81px"><COL style="WIDTH: 75px"><COL style="WIDTH: 165px"><COL style="WIDTH: 165px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD><TD>J</TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Work Order</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Task</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">STATUS</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-SIZE: 8pt; FONT-WEIGHT: bold">% Completion</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Due by</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Scheduled Start Date</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Description</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #c0c0c0; FONT-FAMILY: Calibri; FONT-WEIGHT: bold">Location</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD><TD style="BACKGROUND-COLOR: #c0c0c0"></TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: center">772255</TD><TD style="TEXT-ALIGN: center">01</TD><TD style="TEXT-ALIGN: center">AWAITING 3rd PARTY</TD><TD style="TEXT-ALIGN: center">99</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0">09/11/2008</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0">15/07/2009</TD><TD style="TEXT-ALIGN: center">1 Guy</TD><TD style="TEXT-ALIGN: center">Maki Rd, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: center">772488</TD><TD style="TEXT-ALIGN: center">01</TD><TD style="TEXT-ALIGN: center">AWAITING 3rd PARTY</TD><TD style="TEXT-ALIGN: center">99</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0">09/11/2008</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #f0f0f0">15/07/2009</TD><TD style="TEXT-ALIGN: center">1 Guy</TD><TD style="TEXT-ALIGN: center">Maki Rd, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">782417</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">COMPLETE - Awaiting Inspection</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">100</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">12/02/2009</TD><TD style="BACKGROUND-COLOR: #ff99cc"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">5 Poles Emerg T&T, Coutenay</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ff99cc">Mt Washington, Strathcona</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">814343</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">SCHEDULED</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">20/07/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Tx, Arr, HU service</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Kennedy St, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">807160</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">SCHEDULED</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">07/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">22/07/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Pole Replacement</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Fitzwilliam St, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">816433</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">SCHEDULED</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">17/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01/07/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Pole Replacement</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Raines Rd, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">799190</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">SCHEDULED</TD><TD style="BACKGROUND-COLOR: #ccffff"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">18/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">13/07/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">2 Pole Replacements</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Yellowpoint Rd</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">807187</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">01</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">SCHEDULED</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">60</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">18/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff; COLOR: #339966; FONT-WEIGHT: bold">29/06/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Pole Renewal</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ccffff">Place Rd, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">772635</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">02</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">WORKING</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">20</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">24/05/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">15/06/2009</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">Install New 3ph line</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #33cccc">Boxwood Rd, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">15</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">776791</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">04</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">COMPLETE</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">100</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">24/05/2009</TD><TD style="BACKGROUND-COLOR: #ffcc00"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">Line Deviation</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">Norasea, NAN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">16</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">776791</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">07</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">COMPLETE</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">100</TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">24/05/2009</TD><TD style="BACKGROUND-COLOR: #ffcc00"></TD><TD style="BACKGROUND-COLOR: #ffcc00"></TD><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #ffcc00">Norasea Rd, NAN</TD></TR></TBODY></TABLE>


Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4

And the code for this sheet is as follows;

Private Sub Find_Click()
'
' Find Macro
' Macro recorded 16/06/2009 by XXXXXXXXXXX
'
'
Cells.Find(What:=Search.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
End Sub
Private Sub Possesion_Click()
' Arrange by Current Owner
Range("B6:Z100").Sort Key1:=Range("K6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub Search_Change()
End Sub
Private Sub Status_Click()
' Arrange by STATUS
Range("B6:Z100").Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub WONumber_Click()
' Arrange by Work Order number
Range("B6:Z100").Sort Key1:=Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub DueDate_Click()
' Arrange by Due Date
Range("B6:Z100").Sort Key1:=Range("G6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub StartDate_Click()
' Arrange by Start Date
Range("B6:Z100").Sort Key1:=Range("H6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, i As Long
Dim cell As Range, Answers As Variant
Dim Colors As Variant
Colors = Array(24, 15, 38, 44, 42, 20, 36)
Answers = Array("CLOSED", "SUSPENDED", _
"COMPLETE - Awaiting Inspection", "COMPLETE", "WORKING", _
"SCHEDULED", "READY")
Set rng = Range("E6:E100")
rng.EntireRow.Interior.ColorIndex = xlNone
For Each cell In rng
For i = LBound(Answers) To UBound(Answers)
If LCase(cell) = LCase(Answers(i)) Then
cell.EntireRow.Interior.ColorIndex = Colors(i)
Exit For
End If
Next i
Next cell
End Sub

When I added the copy and move code; I did this;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, i As Long
Dim cell As Range, Answers As Variant
Dim Colors As Variant
Colors = Array(15, 38, 44, 42, 20, 36)
Answers = Array("SUSPENDED", _
"COMPLETE - Awaiting Inspection", "COMPLETE", "WORKING", _
"SCHEDULED", "READY")
Set rng = Range("E6:E100")
rng.EntireRow.Interior.ColorIndex = xlNone
For Each cell In rng
For i = LBound(Answers) To UBound(Answers)
If LCase(cell) = LCase(Answers(i)) Then
cell.EntireRow.Interior.ColorIndex = Colors(i)
Exit For
End If
Next i
Next cell
If Intersect(Target, Columns("e")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then
MsgBox "You can not change multiple cells in col.E"
Application.Undo
Else
If Target.Value = "CLOSED" Then
Target.EntireRow.Cut _
Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2)
Application.CutCopyMode = False
End If
End If
Application.EnableEvents = True
End Sub

Hope this better explains what I,m trying to do and thanks for the help
 
Upvote 0
Just a tip, I've done stuff like this, and I would have to caution about the worksheet_change approach which would do it instantaneously. You would have to create a second macro over on the other sheet to simplify the moving work orders BACK to sheet 1 if you ever accidentally "close" the wrong row.

rI'd suggest the same macro approach, but put an "Archive Work Orders" button on the sheet so I could control the moment when the closed rows are sent to the other sheet.
 
Upvote 0
try
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, x
Dim Answers As Variant
Dim Colors As Variant
Colors = [{15, 38, 44, 42, 20, 36}]
Answers = Array("SUSPENDED", _
"COMPLETE - Awaiting Inspection", "COMPLETE", "WORKING", _
"SCHEDULED", "READY")
Set rng = Range("E6:E100")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then
      MsgBox "You can not change multiple cells in " & rng.Address
      Application.Undo
Else
With Target
    If .Value = "CLOSED" Then
        r.EntireRow.Cut Sheets("Àrchived").Cells(Rows.Count, 1).End(xlUp)(2)
        Application.CutCopyMode = False
    Else
        x = Application.Match(cell.Value, Ansers, 0)
        If IsNumeric(x) Then cell.EntireRow.Interior.ColorIndex = Colors(x)
    End If
End With
Application.EnableEvents = True
End Sub
 
Upvote 0
THAT is a great tip, I think you just saved me from a future meltdown!!!!!!!
Thanks jbeaucaire!
 
Upvote 0
Seiya, Thanks again for your quick reply; I combined jbeaucaire`s advice with your amended code and came up with this;

Private Sub Archive_Click()
'Archive Closed Work Orders to Sheet 2 - 'Archive'
Dim rng As Range, x
Dim Answers As Variant
Dim Colors As Variant
Colors = [{15, 38, 44, 42, 20, 36}]
Answers = Array("SUSPENDED", _
"COMPLETE - Awaiting Inspection", "COMPLETE", "WORKING", _
"SCHEDULED", "READY")
Set rng = Range("E6:E100")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Count > 1 Then
MsgBox "You can not change multiple cells in " & rng.Address
Application.Undo
Else
With Target
If .Value = "CLOSED" Then
r.EntireRow.Cut Sheets("Àrchived").Cells(Rows.Count, 1).End(xlUp)(2)
Application.CutCopyMode = False
Else
x = Application.Match(cell.Value, Ansers, 0)
If IsNumeric(x) Then cell.EntireRow.Interior.ColorIndex = Colors(x)
End If
End With
Application.EnableEvents = True
End Sub

...but I`m getting a compile error; Block If without End If, and I cant see where its missing!
 
Upvote 0
What advise ?

Anyway can you just delete r ?
Rich (BB code): 
    If .Value = "CLOSED" Then
        r.EntireRow.Cut Sheets("Àrchived").Cells(Rows.Count, 1).End(xlUp)(2)
 
Upvote 0
Seiya said:
What advise ?
Click to expand...
..to run the macro from a command button.

Seiya said:
Anyway can you just delete r ?
Rich (BB code): 
    If .Value = "CLOSED" Then
        r.EntireRow.Cut Sheets("Àrchived").Cells(Rows.Count, 1).End(xlUp)(2)
Click to expand...

I deleted r ... still get compile error.
Sorry if I`m being a little slow here; this is all new to me!!!!!
 
Upvote 0
Ahhh
I missed that, Private Sub Archive_Click()
try
Code: 
Private Sub Archive_Click()
'Archive Closed Work Orders to Sheet 2 - 'Archive'
Dim rng As Range, x, r As Range
Dim Answers As Variant
Dim Colors As Variant
Colors = [{15, 38, 44, 42, 20, 36}]
Answers = Array("SUSPENDED", _
"COMPLETE - Awaiting Inspection", "COMPLETE", "WORKING", _
"SCHEDULED", "READY")
Set rng = Range("E6:E100")
again:
For Each r In rng
    If r.Value = "CLOSED" Then
        r.EntireRow.Cut Sheets("Àrchived").Cells(Rows.Count, 1).End(xlUp)(2)
        GoTo again
    Else
        x = Application.Match(r.Value, Ansers, 0)
        If IsNumeric(x) Then r.EntireRow.Interior.ColorIndex = Colors(x)
    End If
Next
Application.CutCopyMode = False
End Sub
However it will need another sub routine to let the wrongly transerred data back to the original sheet as nobody perfect.
So, it should have no difference between Change/Click event for me anyway.
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
VBA to Move Rows Based on Status in Excel
Replies
3
Views
650
Alex Blakenburg
A
D
  • Solved
Using VBA to add a name to a cell
Replies
6
Views
229
deftincu
D
C
  • Question Question
How to check for value in a specific week column with duplicate name rows?
Replies
2
Views
194
KOKOSEK
KOKOSEK
J
  • Question Question
A VBA Code to Transfer rows of cells across Sheets based on Certain Column Value
Replies
2
Views
263
Peter_SSs
Peter_SSs
H
  • Solved
Copy/Move Data from a table to another Sheet to a table
Replies
2
Views
359
himaruasuka
H

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

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