Need help automating task tracker for team= Please help.

[jmawea]

All-

In order to help my team and I stay on top of all the current project tasks on our plates, I've put together the attached tracker. For confidentiality reasons, I've erased the contents of columns B & C.

I've looked on-line for some time and have had no luck. In new to the VBA world and wasn't able to get anything I found to work.

Here is what I'm looking to do.

When something a row on Column D is marked "Done" the whole row is automatically moved to the "Completed Tab"

Team Tracker-Clean.xlsm

P.s. This is my first post! There is so much valuable information in the forum. I look forward to learning from all of you and hope that one day I've learned enough to help others.

[BrianM45]

Hi jmawea

Try this code in Worksheet "Active"

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LastRow As Long
  If Not Intersect(Target, Range("D4:D76")) Is Nothing Then
    If MsgBox("Do you want to move the line ?", vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then
      Application.EnableEvents = False
      Range("B" & Target.Row).UnMerge
      LastRow = Sheets("Completed").Range("D" & Rows.Count).End(xlUp).Row
      Rows(Target.Row).Copy Destination:=Sheets("Completed").Range("A" & LastRow + 1)
      Rows(Target.Row).Delete Shift:=xlUp
      Application.EnableEvents = True
    End If
  End If
End Sub

A+

[jmawea]

Hi Brian-


That was fast. Thank you so much!!!

I was having issues getting the code to run since I'm so new at this but I figured it out. Thanks again.

[jmawea]

On column D, we use dates until it's it is marked "Done" at that point I asks if I want to move and if yes, it works perfect.

Is there a way to remove the question and only move the row when marked done and not promoting to move if I just update the cell?

Thanks,
Manuel

[BrianM45]

Hi,

On column D, we use dates until it's it is marked "Done" at that point I asks if I want to move and if yes, it works perfect.
Is there a way to remove the question and only move the row when marked done and not promoting to move if I just update the cell?

Yes, delete line

If MsgBox("Do you want to move the line ?", vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then

and the line before the last

End If

[jmawea]

Thanks- That got rid of the question, but if i update the cell on row D, it move it to the completed Tab.
Here is what i'm looking for.

If date is changed: No Action- Row stay in place, no question is asked
If date is changed to "Done" The Row is moved to the completed tab

the latter is working, but when I change the date, the current code moves the cell to the complete tab....

Thank you in advance

[BrianM45]

Hi

Haaaa oups ;-)

The correct code

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LastRow As Long
  If Not Intersect(Target, Range("D4:D76")) Is Nothing Then
    If Target.Value = "Done" Then
      Application.EnableEvents = False
      Range("B" & Target.Row).UnMerge
      LastRow = Sheets("Completed").Range("D" & Rows.Count).End(xlUp).Row
      Rows(Target.Row).Copy Destination:=Sheets("Completed").Range("A" & LastRow + 1)
      Rows(Target.Row).Delete Shift:=xlUp
      Application.EnableEvents = True
    End If
  End If
End Sub

Sorry

[jmawea]

That worked, but found one more issue

When I insert a row, I get an error. Here are the screen shots

[BrianM45]

Absolutely fantastic! This is perfect. I really appreciate your help in this.

For nothing ;-)

At one of these days

[jmawea]

Capture2.JPGCapture1.JPG

Oops- here are the screen shots.

[BrianM45]

All right ;-)

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LastRow As Long
  ' Test for no error when insert or delete row
  If Target.Count > 1 Then Exit Sub
  ' Test where change is made
  If Not Intersect(Target, Range("D4:D76")) Is Nothing Then
    If Target.Value = "Done" Then
      Application.EnableEvents = False
      Range("B" & Target.Row).UnMerge
      LastRow = Sheets("Completed").Range("D" & Rows.Count).End(xlUp).Row
      Rows(Target.Row).Copy Destination:=Sheets("Completed").Range("A" & LastRow + 1)
      Rows(Target.Row).Delete Shift:=xlUp
      Application.EnableEvents = True
    End If
  End If
End Sub

[jmawea]

You are a genius. I wish there was something I could do to repay you for all the help. Thank you sooo much!!!!