Help needed to create a VBA macro for moving data to and from other worksheets
Hi all,
I’m trying to create a project workload workbook which has a list of ongoing projects in one worksheet and a separate worksheet for completed projects. I’d like to automatically move a project from the ‘ongoing’ sheet to the ‘completed’ sheet by simply selecting ‘completed’ in the status column. I’d like for this project to move onto the next available row in the ‘completed’ worksheet. I’d also like to be able to move the project back into ‘ongoing’ sheet should the status “completed” have been selected in error.
Please can anyone help me write the correct VBA code to do this? Please find below code which I’ve recently attempted but found it isn’t triggered when selecting the project status (I have to run the macro manually) and when I do, it either moves the project data onto a random row (albeit on the correct sheet), or throws up the VBA window highlighting a section of the code with no explanation as to why it’s an issue!
Any help will be very much appreciated.
Many thanks in advance, Abi.
‘Module Code attempted (but does not work!):’
Sub MoveBasedOnValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets(“Ongoing Mechanical Projects”).UsedRange.Rows.Count
B = Worksheets(“Completed Schemes 2024-2025”).UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets(“Completed Schemes 2024-2025”).UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets(“Ongoing Mechanical Projects”).Range(“L:L” & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = “Completed” Then
xRg(C).EntireRow.Copy Destination:=Worksheets(“Completed Schemes 2024-2025”).Range(“A” & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = “Completed” Then
C = C – 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
‘Sheet Code attempted (but does not work!):’
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Intersect(Target, Range(“L:L”)) Is Nothing Then
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
Application.EnableEvents = True
End If
End Sub
Hi all, I’m trying to create a project workload workbook which has a list of ongoing projects in one worksheet and a separate worksheet for completed projects. I’d like to automatically move a project from the ‘ongoing’ sheet to the ‘completed’ sheet by simply selecting ‘completed’ in the status column. I’d like for this project to move onto the next available row in the ‘completed’ worksheet. I’d also like to be able to move the project back into ‘ongoing’ sheet should the status “completed” have been selected in error. Please can anyone help me write the correct VBA code to do this? Please find below code which I’ve recently attempted but found it isn’t triggered when selecting the project status (I have to run the macro manually) and when I do, it either moves the project data onto a random row (albeit on the correct sheet), or throws up the VBA window highlighting a section of the code with no explanation as to why it’s an issue! Any help will be very much appreciated. Many thanks in advance, Abi.’Module Code attempted (but does not work!):’
Sub MoveBasedOnValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets(“Ongoing Mechanical Projects”).UsedRange.Rows.Count
B = Worksheets(“Completed Schemes 2024-2025”).UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets(“Completed Schemes 2024-2025”).UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets(“Ongoing Mechanical Projects”).Range(“L:L” & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = “Completed” Then
xRg(C).EntireRow.Copy Destination:=Worksheets(“Completed Schemes 2024-2025”).Range(“A” & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = “Completed” Then
C = C – 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
‘Sheet Code attempted (but does not work!):’
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Intersect(Target, Range(“L:L”)) Is Nothing Then
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
Application.EnableEvents = True
End If
End Sub Read More