VBA - Automatically move rows to another tab based on text in cell.

Rzr23

New Member
Joined
Aug 1, 2023
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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