Excel existing code flaw

[QualityAssurance]

Greetings,
I have an excel document that tracks items on a "to-do list", I have an active and historical tab. Active for anything that is still outstanding and the historical for anything that has been completed. I am running a code that will automatically transfer my active tasks to my historical tab once a date is entered into the "completed date" column. The issue I am having is that now that I have reached line 19 in my historical tab, the new items from the active tab continuously replace line 19 on the historical tab when transferring instead of continuing to add a new row. I am at a loss on what in the code is causing the glitch on line 19 specifically. Before it reached line 19 the rows of information would transfer and insert a new row each execution.

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Target.Column = 8 Then
        Application.EnableEvents = False
        If IsDate(Target.Value) Then
            With Target.EntireRow
                .Copy Sheets("Historical Initiatives").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                .Delete
            End With
        End If
    End If
    Application.EnableEvents = True
End Sub

Appreciate the help!
Thank you

 

[Logit]

I don't have a solution for you ... sorry.

I ran your macro here and was able to transfer 34 rows to Sheet "Historical Initiatives". Then the transferring stopped and the entire workbook
quit working. I cleared the data and began anew in the same workbook and the macro would not function at all.

Strange to say the least.

Hopefully someone else can assist you with a solution. Best wishes.

 

[Skyybot]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Target.Column = 8 Then
Application.EnableEvents = False
If IsDate(Target.Value) Then
With Target.EntireRow
.Copy Sheets("Historical Initiatives").Cells(Rows.End(xlUp).Row + 1, 1).
.Delete
End With
End If
End If
Application.EnableEvents = True
End Sub

 

[Skyybot]

Also, I'm not exactly sure why the Application.EnableEvents statement is being used here.

 

[Logit]

I did manage to smash some code together that works here. I was able to transfer 40 entries before I stopped trying. I assume it will continue to work past 40 entries.
This macro recognizes anything entered into cell H1 - not just a date. You can edit the code to restrict it to only a date.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDest = ThisWorkbook.Sheets("Sheet2")
    
    Do While wsSource.Range("H1").Value <> ""
        lastRowSource = wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row
        lastRowDest = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
        
        wsSource.Rows(1).Copy Destination:=wsDest.Rows(lastRowDest)
        wsSource.Rows(1).Delete Shift:=xlUp
    Loop
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

Also, I'm not exactly sure why the Application.EnableEvents statement is being used here.

Because it it wasn't there the same code would be needlessly called again when the row was deleted.

I did manage to smash some code together that works here.

Hmm, I'm wondering if you allowed for the possibility of a heading row in the source worksheet or if you ever entered a date other than right at the top of column H (There was never any mention of only entering in cell H1)?

the new items from the active tab continuously replace line 19 on the historical tab when transferring instead of continuing to add a new row.

The normal cause of that would be that some of the rows being transferred have nothing in column A - but we don't have any of your sample data to test with.


One other comment (unrelated to your problem) is that it may be possible to enter dates in more than one row at a time (eg with Ctrl+Enter or Copy/Paste) so I have allowed for that as well in the code below.

Anyway, give this a try with a copy of your workbook.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, ToDelete As Range, c As Range
  Dim nr As Long
 
  Set Changed = Intersect(Target, Columns("H"))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    Set ToDelete = Range("A1")
    nr = Sheets("Historical Initiatives").Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    For Each c In Changed
      If IsDate(c.Value) Then
        c.EntireRow.Copy Sheets("Historical Initiatives").Range("A" & nr)
        nr = nr + 1
        Set ToDelete = Union(ToDelete, c)
      End If
    Next c
    If ToDelete.Count > 1 Then Intersect(ToDelete, Columns("H")).EntireRow.Delete
    Application.EnableEvents = True
  End If
End Sub

 

[QualityAssurance]

Applied the code Peter_SSs recommended and it's working as advertised.

Really appreciate all the input from everyone, I was losing historical data because I didn't even realize the code was flawed until I needed to reference a historical entry. This is an awesome community to be a part of.

I simply started from the bottom of the thread, don't want anyone thinking that the other posts with recommend VBA were no good. The first attempt worked but will definitely keep this thread in mind in case something weird happens again.

 

[Peter_SSs]

You're welcome. Glad to help. Thanks for the follow-up.

I simply started from the bottom of the thread, don't want anyone thinking that the other posts with recommend VBA were no good. The first attempt worked ..

Regarding this: Just a thought that if you do not even try suggestions people make, & give some sort of feedback, they may be much less likely to offer suggestions for you in the future.

 

[QualityAssurance]

I did manage to smash some code together that works here. I was able to transfer 40 entries before I stopped trying. I assume it will continue to work past 40 entries.
This macro recognizes anything entered into cell H1 - not just a date. You can edit the code to restrict it to only a date.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
   
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDest = ThisWorkbook.Sheets("Sheet2")
   
    Do While wsSource.Range("H1").Value <> ""
        lastRowSource = wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row
        lastRowDest = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
       
        wsSource.Rows(1).Copy Destination:=wsDest.Rows(lastRowDest)
        wsSource.Rows(1).Delete Shift:=xlUp
    Loop
End Sub

Code works, appreciate the feedback.

 

[QualityAssurance]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Target.Column = 8 Then
Application.EnableEvents = False
If IsDate(Target.Value) Then
With Target.EntireRow
.Copy Sheets("Historical Initiatives").Cells(Rows.End(xlUp).Row + 1, 1).
.Delete
End With
End If
End If
Application.EnableEvents = True
End Sub

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Target.Column = 8 Then
Application.EnableEvents = False
If IsDate(Target.Value) Then
With Target.EntireRow
.Copy Sheets("Historical Initiatives").Cells(Rows.End(xlUp).Row + 1, 1).
.Delete
End With
End If
End If
Application.EnableEvents = True
End Sub

Tested roughly 15 lines and the code was working, thanks for the feedback. Appreciate the help