Excel existing code flaw

QualityAssurance

New Member
Joined
Oct 31, 2024
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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
 
Last edited by a moderator:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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.
 
Upvote 0
Try this
VBA 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.End(xlUp).Row + 1, 1).
.Delete
End With
End If
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Also, I'm not exactly sure why the Application.EnableEvents statement is being used here.
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
Solution
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.
 
Upvote 0
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. ;)
 
Upvote 0
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.

VBA Code:
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.
 
Upvote 0
Try this
VBA 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.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
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,223,868
Messages
6,175,082
Members
452,611
Latest member
bls2024

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top