Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 67
Default 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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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!

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 67
Default 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



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Moving data Based on critera.

Yngve.. your a lifesaver!

Working as intended.

Jermaine

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 67
Default Moving data Based on critera.

hi RQtech

You are welcom


Regards Yngve

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Add cells based on critera Needs help[_2_] Excel Discussion (Misc queries) 3 November 1st 07 08:02 PM
Extract data based on critera from three columns Mildred Excel Discussion (Misc queries) 7 February 24th 06 09:34 PM
Macro to add rows and populate cells based on critera Scott Wagner Excel Programming 0 December 23rd 05 03:57 PM
change font color of cell based on critera amrezzat[_9_] Excel Programming 2 November 20th 05 11:07 PM
change font color of cell based on critera amrezzat Excel Worksheet Functions 1 November 20th 05 03:54 PM


All times are GMT +1. The time now is 08:02 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"