Home

Excel VBA

%3CLINGO-SUB%20id%3D%22lingo-sub-297053%22%20slang%3D%22en-US%22%3EExcel%20VBA%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-297053%22%20slang%3D%22en-US%22%3E%3CP%3EHello%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI'm%20in%20charge%20of%20keeping%20track%20multiple%20orders%20distribution%20and%20large%20projects.%20I've%20been%20trying%20to%20write%20a%20VBA%20where%20if%20I%20select%20from%20a%20list%20'yes'%20that%20my%20project%20is%20complete%2C%20it%20moves%20to%20anew%20Completed%20Project%20tab%20in%20the%20same%20workbook.%20The%20VBA%20that%26nbsp%3B%20I%20have%20is%20not%20working.%20Can%20someone%20assist.%20I%20attached%20the%20workbook.%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-297053%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-301722%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20VBA%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-301722%22%20slang%3D%22en-US%22%3E%3CP%3E2%20Options%20for%20you%2C%20On%20workbook%20open()%20as%20you%20had%20it%20before%2C%20code%20in%20ThisWorkbook%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%3EPrivate%20Sub%20Workbook_Open()%3CBR%20%2F%3E%3CBR%20%2F%3E%20Dim%20i%20As%20Integer%3CBR%20%2F%3E%20Dim%20LastRow%20As%20Integer%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Application.ScreenUpdating%20%3D%20False%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20LastRow%20%3D%20Sheets(%22Projects%22).Cells.Find(%22*%22%2C%20searchorder%3A%3DxlByRows%2C%20searchdirection%3A%3DxlPrevious).Row%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20For%20i%20%3D%20LastRow%20To%202%20Step%20-1%3CBR%20%2F%3E%3CBR%20%2F%3E%20If%20Sheets(%22Projects%22).Cells(i%2C%2014).Value%20%3D%20%22Yes%22%20Then%3CBR%20%2F%3E%3CBR%20%2F%3E%20Sheets(%22Projects%22).Range(%22A%22%20%26amp%3B%20i%20%26amp%3B%20%22%3AN%22%20%26amp%3B%20i).Copy%3CBR%20%2F%3E%20Sheets(%22Completed%20Projects%22).Cells(Rows.Count%2C%201).End(xlUp).Offset(1%2C%200).PasteSpecial%20xlPasteValues%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Application.EnableEvents%20%3D%20False%3CBR%20%2F%3E%20Sheets(%22Projects%22).Rows(i%20%26amp%3B%20%22%3A%22%20%26amp%3B%20i).Delete%20Shift%3A%3DxlUp%3CBR%20%2F%3E%20Application.EnableEvents%20%3D%20True%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20End%20If%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Next%20i%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Application.ScreenUpdating%20%3D%20True%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Exit%20Sub%3CBR%20%2F%3E%20%3CBR%20%2F%3EEnd%20Sub%3C%2FPRE%3E%3CP%3E%26nbsp%3BOR%20if%20you%20want%20it%20to%20move%20as%20soon%20as%20it's%20marked%20yes%2C%20put%20this%20in%20Sheet1%20(Projects)%3A%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%3CBR%20%2F%3E%3CBR%20%2F%3E%20Dim%20InRangeRange%20As%20Range%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20If%20InRange(Target%2C%20Sheets(%22Projects%22).Range(%22N%3AN%22))%20Then%3CBR%20%2F%3E%20Call%20MoveToCompleted(Target)%3CBR%20%2F%3E%20End%20If%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3EFunction%20InRange(Range1%20As%20Range%2C%20Range2%20As%20Range)%20As%20Boolean%3CBR%20%2F%3E%3CBR%20%2F%3E%20InRange%20%3D%20Not%20(Application.Intersect(Range1%2C%20Range2)%20Is%20Nothing)%3CBR%20%2F%3E%20%3CBR%20%2F%3EEnd%20Function%3CBR%20%2F%3E%3CBR%20%2F%3EPrivate%20Sub%20MoveToCompleted(Target%20As%20Range)%3CBR%20%2F%3E%3CBR%20%2F%3E%20Application.ScreenUpdating%20%3D%20False%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20On%20Error%20GoTo%20Abort%3CBR%20%2F%3E%3CBR%20%2F%3E%20If%20Target.Value%20%3D%20%22Yes%22%20Then%3CBR%20%2F%3E%3CBR%20%2F%3E%20Sheets(%22Projects%22).Range(%22A%22%20%26amp%3B%20Target.Row%20%26amp%3B%20%22%3AN%22%20%26amp%3B%20Target.Row).Copy%3CBR%20%2F%3E%20Sheets(%22Completed%20Projects%22).Cells(Rows.Count%2C%201).End(xlUp).Offset(1%2C%200).PasteSpecial%20xlPasteValues%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Application.EnableEvents%20%3D%20False%3CBR%20%2F%3E%20Sheets(%22Projects%22).Rows(Target.Row%20%26amp%3B%20%22%3A%22%20%26amp%3B%20Target.Row).Delete%20Shift%3A%3DxlUp%3CBR%20%2F%3E%20Application.EnableEvents%20%3D%20True%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20End%20If%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Application.ScreenUpdating%20%3D%20True%3CBR%20%2F%3E%20%3CBR%20%2F%3E%20Exit%20Sub%3CBR%20%2F%3E%20%3CBR%20%2F%3EAbort%3A%3CBR%20%2F%3E%3CBR%20%2F%3E%20Application.EnableEvents%20%3D%20True%3CBR%20%2F%3E%20Application.ScreenUpdating%20%3D%20True%3CBR%20%2F%3E%20%3CBR%20%2F%3EEnd%20Sub%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-301695%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20VBA%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-301695%22%20slang%3D%22en-US%22%3E%3CP%3EHi%2C%20Does%20it%20need%20to%20run%20or%20workbook%20open()%3F%20Or%20could%20we%20just%20have%20it%20run%20as%20soon%20as%20yes%20is%20selected%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E
Deja8919
Occasional Visitor

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. 

2 Replies

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

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

 

 

 

 

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
46 Replies
Extentions Synchronization
Deleted in Discussions on
3 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
29 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies