I am creating a tracker that will be used as a live sheet. It will be accessed by numerous people and consistently updated. There will be an active tab and a closed tab. On the Active tab, the cells on row N contain a drop down. The drop down options are "In Progress" and "Closed". The goal is that when the cell is changed to "Closed", the entire row will be moved from the Active tab to the Closed tab in the same cell. The Closed tab will need to be a running list. Each time one is closed, it will need to be moved to the next row on the closed sheet. Below is the code I have so far. I am able to successfully move them from the active to closed tab, however it just copies to the same row, overwriting the data, rather than moving to the next row. Any advice on changes that can be made?
Sub MoveClosed()
'Moves closed claims to closed tab
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Active").UsedRange.Rows.Count
J = Worksheets("Closed").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Closed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Active").Range("A1:AQ" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Closed" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Closed").Range("A" & AQ + 3)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Closed" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range
Dim I As Long
On Error Resume Next
Application.ScreenUpdating = False
Set xCell = Target(1)
If xCell.Value = "Closed" Then
I = Worksheets("Closed").UsedRange.Rows.Count
If I = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Closed").UsedRange) = 0 Then I = 0
End If
xCell.EntireRow.Copy Worksheets("Closed").Range("A" & AQ + 3)
xCell.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
Sub MoveClosed()
'Moves closed claims to closed tab
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Active").UsedRange.Rows.Count
J = Worksheets("Closed").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Closed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Active").Range("A1:AQ" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Closed" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Closed").Range("A" & AQ + 3)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Closed" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range
Dim I As Long
On Error Resume Next
Application.ScreenUpdating = False
Set xCell = Target(1)
If xCell.Value = "Closed" Then
I = Worksheets("Closed").UsedRange.Rows.Count
If I = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Closed").UsedRange) = 0 Then I = 0
End If
xCell.EntireRow.Copy Worksheets("Closed").Range("A" & AQ + 3)
xCell.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub