Forum Discussion

Deja8919's avatar
Deja8919
Copper Contributor
Dec 06, 2018

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 anew Completed Project tab in the same workbook. The VBA that  I have is not working. Can someone assist. I attached the workbook. 

excel
Macros and VBA
  • JWR1138's avatar
    JWR1138
    Iron Contributor
    Dec 13, 2018

    Hi, Does it need to run or workbook open()? Or could we just have it run as soon as yes is selected?

    • JWR1138's avatar
      JWR1138
      Iron Contributor
      Dec 13, 2018

      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 Sub

       OR 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

       

       

       

       

Resources