Thread: A Tough one...VBA coding

This is a tough one, I hope some gurus can help me. I have coding that does number 1&2, but I can't figure out how to keep that and do 3 and 4.


I'm going to attach the document and then explain what I'm trying to have happen.

1) worksheet named current: when I change the status in status column to Booked - the entire row will be deleted and moved to the Booked worksheet.
2) worksheet named current: when I change the status in the status column to DNMQ - the entire row will be deleted and moved to the DNMQ worksheet.
3)worksheet named current: when I change the status in the status column to Application, I want todays date to appear in the App Date column (G). I don't want this date to change each time its updated or saved though. A static date if you will. Also, if I change from Approved to closing I dont want the date to change in the column G. Once its there I don't need it to change for tracking purposes.
4) Finally, when there is a change in columns A-F I want another static date to appear in column J. This date wont change until their is any change in columns A-F.

Any help or ideas would be so appreciated.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' stanleydgromjr, 09/05/2011
' Version 3, after copying the Target.Row, delete the Target.Row
' http://www.excelforum.com/excel-programming/790860-move-entire-row-to-another-worksheet-based-on-cell-value.html
If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim P As Long, NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "Booked"
      P = Application.Match("Potential", Worksheets("Booked").Columns(4), 0)
      NR = Worksheets("Booked").Range("D" & P).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Booked").Range("A" & NR)
      Rows(Target.Row).Delete
    Case "DNMQ"
      P = Application.Match("Potential", Worksheets("DNMQ").Columns(4), 0)
      NR = Worksheets("DNMQ").Range("D" & P).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("DNMQ").Range("A" & NR)
      Rows(Target.Row).Delete
  End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub