Forum Discussion
Deja8919
Dec 06, 2018Copper Contributor
Excel VBA
Hello, I'm in charge of keeping track multiple orders distribution and large projects. I've been trying to write a VBA where if I select from a list 'yes' that my project is complete, it moves to...
JWR1138
Dec 13, 2018Iron Contributor
Hi, Does it need to run or workbook open()? Or could we just have it run as soon as yes is selected?
- JWR1138Dec 13, 2018Iron Contributor
2 Options for you, On workbook open() as you had it before, code in ThisWorkbook
Private Sub Workbook_Open()
Dim i As Integer
Dim LastRow As Integer
Application.ScreenUpdating = False
LastRow = Sheets("Projects").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For i = LastRow To 2 Step -1
If Sheets("Projects").Cells(i, 14).Value = "Yes" Then
Sheets("Projects").Range("A" & i & ":N" & i).Copy
Sheets("Completed Projects").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.EnableEvents = False
Sheets("Projects").Rows(i & ":" & i).Delete Shift:=xlUp
Application.EnableEvents = True
End If
Next i
Application.ScreenUpdating = True
Exit Sub
End SubOR if you want it to move as soon as it's marked yes, put this in Sheet1 (Projects):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim InRangeRange As Range
If InRange(Target, Sheets("Projects").Range("N:N")) Then
Call MoveToCompleted(Target)
End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Private Sub MoveToCompleted(Target As Range)
Application.ScreenUpdating = False
On Error GoTo Abort
If Target.Value = "Yes" Then
Sheets("Projects").Range("A" & Target.Row & ":N" & Target.Row).Copy
Sheets("Completed Projects").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.EnableEvents = False
Sheets("Projects").Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
Exit Sub
Abort:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub