PDA

View Full Version : Copy/Paste/Delete based on Date



karrims
11-20-2007, 12:13 PM
You guys really helped me last time...hope you can help again. I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Columns(7)) Is Nothing Then

If Target.Value >= Range("$A$1") Then

With Worksheets("Since Last Meeting")
NextRow = .Range("A1").End(xlDown).Row
If NextRow = 1 And .Cells(NextRow, "A").Value = "" Then
Else
NextRow = NextRow + 1
End If
Target.EntireRow.Copy .Cells(NextRow, "A")
End With


End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

Here's what I want to do:
1. user inputs a date into cell A1 of sheet1 (named "2007 Filled").
2. user enters a date into any cell in column G (same sheet).
3. if date in G is >= the date in A1, copy entire row to sheet2 (named "Since Last Meeting")
4. Delete entire rows from sheet2 with dates in G that are < date in A1 of sheet1.

Confused yet?!? :bug:

Bob Phillips
11-20-2007, 12:20 PM
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NextRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Columns(7)) Is Nothing Then

If Target.Value >= Me.Range("A1").Value Then

With Worksheets("Since Last Meeting")
NextRow = .Range("A1").End(xlDown).Row
If NextRow = 1 And .Cells(NextRow, "A").Value = "" Then
Else
NextRow = NextRow + 1
End If
Target.EntireRow.Copy .Cells(NextRow, "A")
End With
With Me
For i = .Cells(.Rows.Count, "G").End(xlUp).Row To 2 Step -1
If .Cells(i, "G").Value < Me.Range("A1").Value Then
.Cells(i, "G").Delete
End If
Next i
End With
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

karrims
11-20-2007, 12:47 PM
Wow! That was fast, but unfortunately when I entered and tested that code, nothing happens. Suggestions?

Bob Phillips
11-20-2007, 01:08 PM
I was working on the wrong sheet



Private Sub Worksheet_Change(ByVal Target As Range)
Dim NextRow As Long
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Columns(7)) Is Nothing Then

If Target.Value >= Me.Range("A1").Value Then

With Worksheets("Since Last Meeting")
NextRow = .Range("A1").End(xlDown).Row
If NextRow = 1 And .Cells(NextRow, "A").Value = "" Then
Else
NextRow = NextRow + 1
End If
Target.EntireRow.Copy .Cells(NextRow, "A")
For i = .Cells(.Rows.Count, "G").End(xlUp).Row To 2 Step -1
If .Cells(i, "G").Value < Me.Range("A1").Value Then
.Rows(i).Delete
End If
Next i
End With
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

karrims
11-20-2007, 01:26 PM
Maybe I'm doing something wrong...here is my workbook...