VBA only allows 2 rows then starts to overwrite why?

[DMO123]

Hi All,

i have the below VBA code. when a row is marked as "CLOSED" on another tab the row moves to a new tab. but there seems to be an error with the code as it only allows 2 rows in the new tab then starts to overwrite the rows. any help on how to fix this will be highly appreciated!

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Intersect(Target, Columns("S:S")) Is Nothing Then Exit Sub
    Dim bottomA As Long
    bottomA = Sheet16.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).End(xlUp).Offset(1).Row
    Application.ScreenUpdating = False
    If Target.Value = "CLOSED" Then
        Target.EntireRow.Copy Sheet16.Cells(bottomA, 1)
        Sheet16.Range("X" & bottomA) = Now
        Sheet16.Range("Y" & bottomA) = Application.UserName
        Target.EntireRow.Delete
    End If
    Sheet16.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Eric Golf]

Hi,

The highlighted section in Red Bold below will likely go to row 2, try deleting it, or replace with "+1" to go to the next free row?

Hi All,

i have the below VBA code. when a row is marked as "CLOSED" on another tab the row moves to a new tab. but there seems to be an error with the code as it only allows 2 rows in the new tab then starts to overwrite the rows. any help on how to fix this will be highly appreciated!

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Intersect(Target, Columns("S:S")) Is Nothing Then Exit Sub
    Dim bottomA As Long
    bottomA = Sheet16.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)[COLOR="#FF0000"][B].End(xlUp).Offset(1).Row[/B][/COLOR]
    Application.ScreenUpdating = False
    If Target.Value = "CLOSED" Then
        Target.EntireRow.Copy Sheet16.Cells(bottomA, 1)
        Sheet16.Range("X" & bottomA) = Now
        Sheet16.Range("Y" & bottomA) = Application.UserName
        Target.EntireRow.Delete
    End If
    Sheet16.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Hope this helps,

Eric

 

[footoo]

.

 

[Fluff]

A simpler version

bottomA = Sheet16.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

Does col A on sheet16 always have data?

 

[DMO123]

@Fluff only when rows are moved but yes it is something that is always there as its the number of item.

 

[Fluff]

In that case have you tried my suggestion?

 

[DMO123]

@Fluff - thank you for your help worked perfectly.

 

[Fluff]

You're welcome & thanks for the feedback