Moving data Based on critera.
 

Hello all,

I've done numerous searches and this topic has been covered over and
over again, but I can't seem to edit anyone elses' solution to get to
my own. So I'm asking for help

I've got an ongoing to-do list that has a list of tasks on it.
I'd like to be able to move all the completed tasks (entire row) to the
bottom of a similar worksheet labeled "Completed"
However a task is only complete when the text in column H says "100%"
and the text in column L says "Yes"

I'd also like it to automatically update. So as soon as soon as this
critera it met, it will move. It would also be nice if it could delete
the row once moved, as to not have any empty rows in my list..


Seeking help
Jermaine

Moving data Based on critera.
 

Hi RQtech

Try this

Some of it I copy`d from RonDeBruin.

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Column = 12 Then ' column "L"
If Target.Value = "Yes" And Target.Offset(0, -4).Value = 1 Then
Dim destrange As Range
Dim sourceRange As Range

Dim Lr As Long
Dim targetRow As Double
targetRow = Val(Mid(Target.Address, 4))
Lr = Worksheets("Completed").Cells(Rows.Count,
"A").End(xlUp).Row + 1

Set sourceRange = Sheets("Your sheetName").Rows(targetRow)
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete (xlUp)
End If
End If
End Sub

Regards Yngve

Moving data Based on critera.
 

Thank you very much!! I've almost got it.. now I'm trying to revers it
so if they enter 100% and it column "l" is Yes then to do the same
thing. Like an inverse shouldn't be to hard.

But again Thank you

Moving data Based on critera.
 

Okay so in trying to inverse the code above a get stop when trying to
put another if statement in the Worksheet_Change sub.

The code works when; completed is 100% and the user changes column L to
a "Yes"
However I also need it to work inverse. When Column L is a "Yes" and
the user changes completed to 100% it should do the same function

This is what I got, does not work

Private Sub Worksheet_Change(ByVal Target As Range)


'Column "L" if a "Yes" is entered in invoice
If Target.Column = 12 Then ' column "L"
If Target.Value = "Yes" And Target.Offset(0, -4).Value = 1 Then
Dim destrange As Range
Dim sourceRange As Range


Dim Lr As Long
Dim targetRow As Double
targetRow = Val(Mid(Target.Address, 4))
Lr = Worksheets("Completed").Cells(Rows.Count,
"A").End(xlUp).Row + 1


Set sourceRange = Sheets("trailblazer").Rows(targetRow)
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete (xlUp)
End If

End If

'Column "H" if a "100%" is entered in completed
If Target.Column = 8 Then ' column "H"
If Target.Value = "100%" And Target.Offset(0, 4).Value = "Yes" Then

targetRow = Val(Mid(Target.Address, 4))
Lr = Worksheets("Completed").Cells(Rows.Count,
"A").End(xlUp).Row + 1


Set sourceRange = Sheets("trailblazer").Rows(targetRow)
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete (xlUp)
End If
End If

End Sub

Thanks for more help!

Moving data Based on critera.
 

Hi RQtech

(100% = 1)!!!! I have tested the sub.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' pevent sub for repeting it self
On Error GoTo Errh
'Column "L" if a "Yes" is entered in invoice
If Target.Column = 12 Then ' column "L"
If Target.Value = "Yes" And Target.Offset(0, -4).Value = 1 Then
Dim destrange As Range
Dim sourceRange As Range


Dim Lr As Long
Dim targetRow As Double
targetRow = Val(Mid(Target.Address, 4))
Lr = Worksheets("completed").Cells(Rows.Count,
"A").End(xlUp).Row + 1


Set sourceRange = Sheets("trailblazer").Rows(targetRow)
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete (xlUp)
End If

'Column "H" if a "100%" is entered in completed
ElseIf Target.Column = 8 Then ' column "H"
If Target.Value = 1 And Target.Offset(0, 4).Value = "Yes" Then


targetRow = Val(Mid(Target.Address, 4))
Lr = Worksheets("completed").Cells(Rows.Count,
"A").End(xlUp).Row + 1


Set sourceRange = Sheets("trailblazer").Rows(targetRow)
Set destrange = Sheets("Completed").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete (xlUp)

End If



End If
'Application.EnableEvents = True
Errh: Application.EnableEvents = True
End Sub

Regards Yngve

Moving data Based on critera.
 

Yngve.. your a lifesaver!

Working as intended.

Jermaine

Moving data Based on critera.
 

hi RQtech

You are welcom


Regards Yngve