Automatically move rows to another sheet based on a cell value with two handlers

[whitoulias]

Hi,

Excel version: 2016

I am trying unsuccessfully to combine two handlers.

The first one finds the value "Yes" in Column H and moves it to the Settled sheet. There is an issue though with this one as it seems that the data are copied to the Settled sheet over and over in row A instead of one under the other

Private Sub Worksheet_Change(ByVal Target As Range)

Lastrow = Worksheets("Active").UsedRange.Rows.Count
lastrow2 = Worksheets("Settled").UsedRange.Rows.Count
If lastrow2 = 1 Then
    lastrow2 = 0
    Else
End If
Do While Application.WorksheetFunction.CountIf(Range("H:H"), "Yes") > 0
    Set Check = Range("H1:H" & Lastrow)
    For Each Cell In Check
        If Cell = "Yes" Then
            Cell.EntireRow.Copy Destination:=Worksheets("Settled").Range("A" & lastrow2 + 1)
            Cell.EntireRow.Delete
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next
Loop
       
End Sub

The second tracks the changes users make

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    
     
        If Not Intersect(Target, Range("L:L")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Cells(Target.Row, "K").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy hh:mm:ss")
        End If
        
        If Not Intersect(Target, Range("I:I")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Cells(Target.Row, "J").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy")
        End If
    Application.EnableEvents = True
       
End Sub

Has anyone have any idea how can I combine both in one?
Thank you in advance

 

[Joe4]

A few questions we need the answers to:

Is the sheet that these codes are placed on named "Active"?

Do you only want the first code that copies the data over to the "Settled" sheet to run as a "Yes" is put in column H?

Are the values in column "H" hard-coded, or the result of formulas?

If formulas, what is the formula?

 

[whitoulias]

A few questions we need the answers to:

Is the sheet that these codes are placed on named "Active"?

Do you only want the first code that copies the data over to the "Settled" sheet to run as a "Yes" is put in column H?

Are the values in column "H" hard-coded, or the result of formulas?

If formulas, what is the formula?

The codes are placed on the Active sheet, that is correct.

Yes in column H is the only prerequisite for the row to be moved.

The values for the moment are based on a list but we can amend to whatever is easier, perhaps manually.

Hope this helps.

Thank you for your time!

 

[Joe4]

OK, you answered my first question, but really not the other ones.
Those are important, because Worksheet_Change procedure only run on certain things based on certain conditions.
Those details matter greatly.

So let's try again:

In regards to the first code you posted:

- Are the values in column H hard-coded or the results of formulas?
If column H has formulas that are returning "Yes", please post for us what one of these formulas look like.

-WHEN do you want that code to run?
Should it only run when the value in column H changes?
Or are you trying to run it on a whole set of exisiting data at the same time (in which case, you probably would not want to use Worksheet_Change)?

 

[whitoulias]

OK, you answered my first question, but really not the other ones.
Those are important, because Worksheet_Change procedure only run on certain things based on certain conditions.
Those details matter greatly.

So let's try again:

In regards to the first code you posted:

- Are the values in column H hard-coded or the results of formulas?
If column H has formulas that are returning "Yes", please post for us what one of these formulas look like.

-WHEN do you want that code to run?
Should it only run when the value in column H changes?
Or are you trying to run it on a whole set of exisiting data at the same time (in which case, you probably would not want to use Worksheet_Change)?

Really sorry for not being clear.

- In every cell in Column H there is a drop down list with two option "Yes" and "No". List is in T6:T7. There is no option for a blank.

- The code needs to be run every time any cell in H column turns into Yes. So currently every row has a "No" which at some point will turn into yes.

Thank you!

 

[Joe4]

Sorry, I was out of town all weekend.

I think this will do all that you want:

Private Sub Worksheet_Change(ByVal Target As Range)

'   Only run if change made to one single cell
    If Target.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

'   Check to see column H was updated to "Yes"
    If (Target.Column = 8) And (Target.Value = "Yes") Then
'       Copy row to "Settled Sheet"
        Rows(Target.Row).Copy Sheets("Settled").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'       Delete row
        Rows(Target.Row).Delete
        Application.EnableEvents = True
    End If

'   Check for update to column L
    If Not Intersect(Target, Range("L:L")) Is Nothing Then
        Cells(Target.Row, "K").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy hh:mm:ss")
    End If
        
'   Check for update to column I
    If Not Intersect(Target, Range("I:I")) Is Nothing Then
        Cells(Target.Row, "J").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy")
    End If
    
    Application.EnableEvents = True
       
End Sub

 

[whitoulias]

Sorry for not getting back earlier. Really appreciate your effort and time.

The transfer part works great. The whole row is transferred to the Settled Sheet and is deleted from the active.

The issue is that after that i am getting a Run-time error '1004':

Method 'Intersect' of 'Object'_Global' failed and the following is highlighted for debugging

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

Would it be perhaps better to run the second part first?

Thank you

 

[Joe4]

I think you Delete row may be calling the code again,
It looks like we have an extra EnableEvents line that we forgot to remove.
And yes, I think it might be better to flip the order, so the delete lines happen last.

Does this work any better?

Private Sub Worksheet_Change(ByVal Target As Range)

'   Only run if change made to one single cell
    If Target.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

'   Check for update to column L
    If Not Intersect(Target, Range("L:L")) Is Nothing Then
        Cells(Target.Row, "K").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy hh:mm:ss")
    End If
        
'   Check for update to column I
    If Not Intersect(Target, Range("I:I")) Is Nothing Then
        Cells(Target.Row, "J").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy")
    End If

'   Check to see column H was updated to "Yes"
    If (Target.Column = 8) And (Target.Value = "Yes") Then
'       Copy row to "Settled Sheet"
        Rows(Target.Row).Copy Sheets("Settled").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'       Delete row
        Rows(Target.Row).Delete
    End If

    Application.EnableEvents = True
       
End Sub

 

[whitoulias]

I think you Delete row may be calling the code again,
It looks like we have an extra EnableEvents line that we forgot to remove.
And yes, I think it might be better to flip the order, so the delete lines happen last.

Does this work any better?

Private Sub Worksheet_Change(ByVal Target As Range)

'   Only run if change made to one single cell
    If Target.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

'   Check for update to column L
    If Not Intersect(Target, Range("L:L")) Is Nothing Then
        Cells(Target.Row, "K").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy hh:mm:ss")
    End If
       
'   Check for update to column I
    If Not Intersect(Target, Range("I:I")) Is Nothing Then
        Cells(Target.Row, "J").Value = Environ("username") & " " & Format(Now, "dd/mm/yyyy")
    End If

'   Check to see column H was updated to "Yes"
    If (Target.Column = 8) And (Target.Value = "Yes") Then
'       Copy row to "Settled Sheet"
        Rows(Target.Row).Copy Sheets("Settled").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'       Delete row
        Rows(Target.Row).Delete
    End If

    Application.EnableEvents = True
      
End Sub

Works a treat Joe thank you for your time and effort. Sorry for the late response!!

 

[Joe4]

You are welcome.

Note when marking a solution, you want to mark the post from the user that contains the solution (not a post acknowledging that a previous post is the solution).