Automatically move entire rows from one Worksheet into another Worksheet in the same Workbook

[joeyjay]

I have a Task List Workbook (with 2 Worksheets)

Worksheet 1 will be just for Open Task Items. Worksheet 2 will be just for Closed Items.

Worksheet 1 will consist of rows of Open Items.

The last column for each row on Worksheet 1 will either be a checkbox (for task completed) or a cell that we type a "completed date" into.

Once the last column cell is checked as completed or the cell is populated with a complete date, is there a way to have that be the trigger for the entire row to transfer over (be cut) from Worksheet to Worksheet 2 of the same Workbook?

Again, Worksheet 1 will be just for Open Task Items and Worksheet 2 will be just for Closed Items.

Thank you for your help.

 

[LBinGA]

I am now having the same problem as ExcelNovy, Big C. The code has been working perfectly for months but now, on about the 4th or 5th move of a row (by entering "Yes" in the column, I get the same exact error he/she got:
Run-time error'-2147417848 (80010108)':
Method 'Insert' of object 'Range' failed

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDest As Range
Set rngDest = Worksheets("Archive").Range("rngDest")
Dim rngTrigger As Range
 
' Limit the trap area to range of cells in which completed dates are entered as defined above
If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then
 
' Only trigger if the value entered is TRUE
    
     If Target.Value = "Yes" 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
[B]        rngDest.Insert Shift:=xlDown[/B]
        Selection.Delete
' Reset EnableEvents
        Application.EnableEvents = True
    End If
End If


    On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
        With Worksheets("Home Office").Sort
              .SortFields.Clear
              .SortFields.Add Key:=Range("B:B"), _
                   SortOn:=xlSortOnValues, _
                   Order:=xlAscending, _
                   DataOption:=xlSortNormal
                   
      .SetRange Range("A5:F25")
              .Header = xlNo
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
          End With
    End If
                   
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
        With Worksheets("Marketing").Sort
              .SortFields.Clear
              .SortFields.Add Key:=Range("B:B"), _
                   SortOn:=xlSortOnValues, _
                   Order:=xlAscending, _
                   DataOption:=xlSortNormal
                     
              .SetRange Range("A5:F25")
              .Header = xlNo
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
          End With
    End If
 
End Sub

The code stops on the bolded line above, then in the bottom left hand corner of the screen it says "Select Destination and click enter or choose Paste".

If I go nowhere except to the top Menu and click Paste, Excel craps out, recovers and when it comes back, the Row has been moved to the Archive.

I checked the code over and over. There isn't a clear reason why it should work for months and now doesn't....or that it should work 4 or 5 times, different sheets, different rows, then gives the error.

ANY help would be much appreciated. Upper management used this sheet and I would like to get it working before it happens to one of them.

Thanks so much,
LBinGA

 

[LBinGA]

Additionally, I've checked the rngDest Named Range. It correctly shows the next blank row on the page as =ARCHIVE!$59:$59, and increased with each add, correctly. Everything appears to be correct...and has been working. Until today.

Thanks again,
LB in GA

 

[LBinGA]

I believe I discovered the reason for the error. It is copying my Conditional Formatting over to the Archive page and it will only handle that so many times on that page. Can anyone help me with a code that would strip the Conditional formatting from the row as it gets entered onto the Archive tab?

Thanks,

 

[LBinGA]

I've changed the code to read as follows:

[CODE If Target.Value = "Yes" 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.ClearFormats
rngDest.Insert Shift:=xlDown
Selection.Delete
' Reset EnableEvents
Application.EnableEvents = True
End If
End If][/CODE]

So now, it drops in a blank line into the Archive tab. I ONLY want to clear the Conditional formatting, not the actual text!

Anyone?

LBinGA

 

[BigC]

Glad to see that you've located the source of the error.

To clear the conditional formatting from the row to be moved, after

Target.EntireRow.Select

insert:

Selection.FormatConditions.Delete

Also note that there are a couple of improvements that can be made to your code:

1. You've declared the variable "rngTrigger" with

   Dim rngTrigger As Range

   but then not used that variable, as you've referenced the range directly with

   If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then

   So, I suggest you either:
   • delete the Dim declaration
     or:
   • include

     Set rngTrigger = Range("rngTrigger")

     and
   • change

     If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then

     to

     If Not Intersect(Target, rngTrigger) Is Nothing Then

2. There is no need to repeat the test

   If Not Intersect(Target, Range("B:B")) Is Nothing Then

   in order to perform a second action, so I recommend you delete the following lines between the two actions you want to occur:
   

   End If
   
   If Not Intersect(Target, Range("B:B")) Is Nothing Then

HTH

 

[LBinGA]

Glad to see that you've located the source of the error.

To clear the conditional formatting from the row to be moved, after

Target.EntireRow.Select

insert:

Selection.FormatConditions.Delete

Also note that there are a couple of improvements that can be made to your code:

1. You've declared the variable "rngTrigger" with

   Dim rngTrigger As Range

   but then not used that variable, as you've referenced the range directly with

   If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then

   So, I suggest you either:
   • delete the Dim declaration
     or:
   • include

     Set rngTrigger = Range("rngTrigger")

     and
   • change

     If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then

     to

     If Not Intersect(Target, rngTrigger) Is Nothing Then

2. There is no need to repeat the test

   If Not Intersect(Target, Range("B:B")) Is Nothing Then

   in order to perform a second action, so I recommend you delete the following lines between the two actions you want to occur:
   

   End If
   
   If Not Intersect(Target, Range("B:B")) Is Nothing Then

HTH

Thank you, Big C!

I used

rngDest.FormatConditions.Delete

and it worked!
What would the difference be if I used

Selection.FormatConditions.Delete

Also, I applied your other recommendation like so and am getting a RunTime Error #5 Invalid Procedure Call or Argument, when I enter data in any of the cells:

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDest As Range
Set rngDest = Worksheets("Archive").Range("rngDest")
Dim rngTrigger As Range


S[B]et rngTrigger = Range("rngTrigger")[/B]
 
' Limit the trap area to range of cells in which completed dates are entered as defined above
[B]If Not Intersect(Target, rngTrigger)[/B] Is Nothing Then


' Only trigger if the value entered is TRUE
    
     If Target.Value = "Yes" 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.FormatConditions.Delete
        rngDest.Insert Shift:=xlDown
        Selection.Delete
' Reset EnableEvents
        Application.EnableEvents = True
    End If




    On Error Resume Next


[B] 'removed End If and If Not Intersect(Target, Range("B:B")) Is Nothing Then[/B]
        With Worksheets("IT").Sort
              .SortFields.Clear
              .SortFields.Add Key:=Range("B:B"), _
                   SortOn:=xlSortOnValues, _
                   Order:=xlAscending, _
                   DataOption:=xlSortNormal
                   
      .SetRange Range("A5:F15")
              .Header = xlNo
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
          End With
    End If
End Sub

Thanks!

 

[BigC]

1. I suggested

Selection.FormatConditions.Delete

immediately after

Target.EntireRow.Select

rather than

rngDest.FormatConditions.Delete

after the move as you indicated that Excel will only handle copying your Conditional Formatting over to the Archive page so many times on that page (so best clear the CF before it is copied), and it seemed easier (the row to be moved has just been selected), but it shouldn't really matter.


2. The new error may result from not fully referencing the rngDest variable when initializing it, so use

Set rngTrigger = Range("rngTrigger")

only if the Defined Name was created with Workbook scope, otherwise use

Worksheets("[local sheet name]").Range("rngTrigger")

if you gave it Sheet scope (replace "[local sheet name]" with the name of the parent sheet).


3. I also notice that you've modified the second part of your code which sorts your sheets:

1. in the first set of code you posted you were sorting the "Home Office" and "Marketing" worksheets, now it's only "IT", and
2. changed the test which triggers the sorting from:

If Not Intersect(Target, Range("B:B")) Is Nothing Then

which was independent of the earlier double-barrel test, viz;
​

If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then
' Only trigger if the value entered is TRUE
If Target.Value = "Yes" Then

to now be triggered by the latter.

That's Ok if that's what you want - just be sure as to what condition/s must be true before the sorting is done, and position your sorting code in the appropriate location.
​

 

[LBinGA]

Yes, it's working now, perfectly, on that one sheet. Thank you for all of your help on that!

Today, I have another challenge. This is a different Workbook, but same type of vba. In this workbook, I have a number of sheets:

Prospects, Submissions, Quoted & Bound

I want a matching ARCHIVE sheet for each of these, so I would have Prospects ARCHIVE, Subs ARCHIVE and Quote & Board ARCHIVE. I installed this code on the Prospects Archive:

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDest As Range
Set rngDest = Worksheets("Archive").Range("rngDest")
Dim rngTrigger As Range
 
' Limit the trap area to range of cells in which completed dates are entered as defined above
If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then
 
' Only trigger if the value entered is TRUE
    
     If Target.Value = "Yes" 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.FormatConditions.Delete
        Selection.Cut
        rngDest.Insert Shift:=xlDown
        Selection.Delete
' Reset EnableEvents
        Application.EnableEvents = True
    End If
End If


    On Error Resume Next
 
End Sub

Works great.

Then, I created a sheet called "Q & B Archive", assigned the Named Ranges and installed this code on the Quoted & Bound Sheet:

Dim rngDestQB As Range
Set rngDestQB = Worksheets("Q & B Archive").Range("rngDestQB")
Dim rngTriggerQB As Range
 
' Limit the trap area to range of cells in which Yes is entered as defined above
If Not Intersect(Target, Range("rngTriggerQB")) Is Nothing Then
 
' Only trigger if the value entered is TRUE
    
     If Target.Value = "Yes" 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
        Selection.FormatConditions.Delete
[B]        rngDestQB.Insert Shift:=xlDown[/B]
        Selection.Delete
' Reset EnableEvents
        Application.EnableEvents = True
    End If
End If


    On Error Resume Next
End Sub

And only ONE of the sheets will work. The other craps out on the bolded line above. Certainly, I can have two sheet perform the same type module when they are named different ranges on different sheet???

And clue what might be happening here?

Thanks again for all the help.

LB in GA

 

[LBinGA]

I get a Run-Time error '-2147417848 (80010108)':
Method of 'Insert' of Object 'Range' failed.

When I enter yes in the Trigger column on Prospects, if the Q & B Archive is present. If it is not present (deleted), Prospects works like a charm.

Very frustrating.

Thanks,

LB in GA

 

[BigC]

LBinGA

1.

I installed this code on the Prospects Archive:

Why add the code to this sheet - isn't it the destination? Should you not have added the code to the "Prospects" sheet?

2.

Set rngDest = Worksheets("Archive").Range("rngDest")

As per comments above, shouldn't the sheet name be "Prospects Archive" rather than just "Archive"?

3. There seems to be some inconsistencies between the highlighted comments and the code lines:

' Limit the trap area to range of cells in which [B][COLOR=#ff0000]completed dates[/COLOR][/B] are entered [B][COLOR=#ff0000]as defined above[/COLOR][/B]
If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then
 
' Only trigger if the value entered is [B][COLOR=#ff0000]TRUE[/COLOR][/B]
    
     If Target.Value = "[B][COLOR=#ff0000]Yes[/COLOR][/B]" Then

4. The "Resume Next" form of error handler may not be the best option, and having at the very end of your sub achieves little.

On Error Resume Next
End Sub

5.

Dim [COLOR=#ff0000]rngDestQB [/COLOR]As Range
Set [COLOR=#ff0000]rngDestQB [/COLOR]= Worksheets("Q & B Archive").Range("[COLOR=#ff0000]rngDestQB[/COLOR]")
Dim [COLOR=#ff0000]rngTriggerQB [/COLOR]As Range
 
' Limit the trap area to range of cells in which Yes is entered as defined above
If Not Intersect(Target, Range("[COLOR=#ff0000]rngTriggerQB[/COLOR]")) Is Nothing Then

It is not necessary to create:

• unique VBA variables like "rngDestQB" and rngTriggerQB, and
• unique Defined Names like "rngDestQB" and "rngTriggerQB"

when using the same VBA variables name "rngDest" and "rngTrigger", and related Defined Names "rngDest" and "rngTrigger" (both created with Sheet scope), means all the code behind each sheet is the same (with less risk of creating errors, easier to debug, maintain, etc.)

6. I suggest the following changes to this section of code:

Application.EnableEvents = False
Target.EntireRow.Select
Selection.Cut '[Move down one row, below Selection.FormatConditions.Delete, as per previous post on this matter.]
Selection.FormatConditions.Delete
rngDestQB.Insert Shift:=xlDown '[See comment # 5 about variable name >> use "rngDest" rather than "rngDestQB"]
Selection.Delete
' Reset EnableEvents
Application.EnableEvents = True
​

7.

When I enter yes in the Trigger column on Prospects, if the Q & B Archive is present. If it is not present (deleted), Prospects works like a charm.

I'm not sure what you mean here.
If you set up this new workbook as per the instructions earlier in the thread I don't see why the presence or not of "Q & B Archive" has any impact on what you do in "Prospects".

In your case I believe you should have:

• operating/source sheets named "Prospects", "Submissions", and "Quoted & Bound" (each with with a Defined Name for the trigger range), and
• matching archive sheets named "Prospects ARCHIVE", "Subs ARCHIVE" and "Quote & Bound ARCHIVE" (each with a "sheet scoped" Defined Name for the destination range)

I hope that helps.