Forum Discussion
ACharles2
Sep 10, 2024Copper Contributor
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 pr...
JKPieterse
Sep 10, 2024Silver Contributor
ACharles2 OK, here is my attempt.
This goes in the code module behind the worksheet:
Option Explicit
'This should work
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Not Intersect(Target, Range("L:L")) Is Nothing Then
Application.EnableEvents = False
MoveBasedOnValue Target
Application.EnableEvents = True
End If
End Sub
And this in a normal module:
Option Explicit
'Module Code (worked for me)
Sub MoveBasedOnValue(xRg As Range)
Dim B As Long
Dim rngArea As Range
Dim cl As Range
Dim rng2Delete As Range
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
On Error Resume Next
Application.ScreenUpdating = False
'If non-adjacent cells have been selected, we have to loop through the areas
For Each rngArea In xRg.Areas
'Then we loop through the cells in each area
For Each cl In rngArea.Cells
If CStr(cl.Value) = "Completed" Then
'We have a hit, add this to a range of cells that need to be copied below
If rng2Delete Is Nothing Then
Set rng2Delete = cl
Else
Set rng2Delete = Union(rng2Delete, cl)
End If
End If
Next
Next
'There are cells to move. Do them all in two single statements
If Not rng2Delete Is Nothing Then
rng2Delete.EntireRow.Copy Destination:=Worksheets("Completed Schemes 2024-2025").Range("A" & B + 1)
rng2Delete.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
ACharles2
Sep 11, 2024Copper Contributor
This does work to the extent where the project data will move from 'Ongoing Mechanical Projects' to 'Completed Schemes 2024-25' when the status "completed" is selected - thank you! Now I'd like to be able to move the data back, should the "completed" status have been selected in error. Any chance you can help me with this next step please?