Scribd
Upload
2 views18 pages

Work Order Manager

The document is a comprehensive guide on creating an Excel Work Order application using VBA, authored by Randy Austin, a recognized expert in Excel development. It includes detailed instructions, source code, and various resources for learning and enhancing Excel skills. Additionally, it highlights the author's background and the community built around Excel For Freelancers.

Uploaded by

Sirine Hedfi
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
2 views18 pages

Work Order Manager

The document is a comprehensive guide on creating an Excel Work Order application using VBA, authored by Randy Austin, a recognized expert in Excel development. It includes detailed instructions, source code, and various resources for learning and enhancing Excel skills. Additionally, it highlights the author's background and the community built around Excel For Freelancers.

Uploaded by

Sirine Hedfi
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd

VBA SOURCE

CODE BOOK

Learn How To Create This


Excel Work Order
Application & Mobile Sync

DOWNLOAD VIEW
APPLICATION TRAINING

by: Randy Austin


ABOUT THE AUTHOR
A two-time Microsoft MVP & lifetime Excel enthusiast, Randy
Austin founded Excel For Freelancers in 2017. Excel For
Freelancers quickly became the most prominent resource Excel
for developers to learn how to turn their passion for Excel into
profits by building & selling their own excel-based applications
for passive & recurring income.

With nearly 300,000 YouTube subscribers, 14,000,000 video


views, 200+ comprehensive training videos, and a thriving 40,000
member Facebook community, Excel For Freelancers has
positioned itself as the #1 Excel developers resource in the world.

Get free content, training, and downloads just by clicking any of the free
resources below:

WEBSITE YOUTUBE FACEBOOK TWITTER

INSTAGRAM TELEGRAM RUMBLE


OUR COURSES &
PRODUCTS
This comprehensive program will take you through
a 12-phase process that will turn your enthusiasm
for Excel into passive income.
Click here to learn more

16 hour masterclass that will teach you the tips,


tricks and techniques on how to create a dynamic
single-click dashboard, and a ton more
Click here to learn more

Incredible Package of 175 of my BEST Applications


into a SINGLE ZIP File which also includes the "175
Workbook Library".

Click here to learn more

With 1000 live links, continuously updating content,


sort-able and filterable items, you will always have
exactly what you need, when you need it.

Click here to learn more


Table of Contents
Projects ..............................................................................................................................................................................................2
VBAProject .....................................................................................................................................................................................2
Documents ..................................................................................................................................................................................2
Sheet1......................................................................................................................................................................................2
(Declarations)........................................................................................................................................................................2
Worksheet_SelectionChange [Sub ] .....................................................................................................................................2
Sheet2......................................................................................................................................................................................4
(Declarations)........................................................................................................................................................................4
Sheet3......................................................................................................................................................................................6
(Declarations)........................................................................................................................................................................6
ThisWorkbook ..........................................................................................................................................................................8
(Declarations)........................................................................................................................................................................8
Modules .....................................................................................................................................................................................10
CheckUpdateMac ...................................................................................................................................................................10
(Declarations)......................................................................................................................................................................10
CheckAndUpdateWO [Sub ] ...............................................................................................................................................10
WOSaveLoadMacs ................................................................................................................................................................12
(Declarations)......................................................................................................................................................................12
WO_CancelNew [Sub ] .......................................................................................................................................................12
WO_Delete [Sub ] ...............................................................................................................................................................12
WO_Load [Sub ] .................................................................................................................................................................12
WO_New [Sub ] ..................................................................................................................................................................12
WO_SaveUpdate [Sub ] ......................................................................................................................................................12

1 of 14
T
Sheet1 Work_Order_Manager.xlsm

1 Option Explicit
2
3 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
4 If Not Intersect(Target, Range("D17:K9999" )) Is Nothing And Range("D" & [Link]).
Value <> Empty Then
5 Range("B5" ).Value = [Link]
6 WO_Load
7 End If
8 End Sub

2 of 14
Index

E
Empty, 2
Explicit, 2

I
Intersect, 2

R
Range, 2
Row, 2

T
Target, 2

V
Value, 2

W
WO_Load, 2
Worksheet_SelectionChange, 2

3 of 14
Sheet2 Work_Order_Manager.xlsm

1 Option Explicit
2

4 of 14
Index

E
Explicit, 4

5 of 14
Sheet3 Work_Order_Manager.xlsm

1 Option Explicit
2

6 of 14
Index

E
Explicit, 6

7 of 14
ThisWorkbook Work_Order_Manager.xlsm

1 Option Explicit
2

8 of 14
Index

E
Explicit, 8

9 of 14
T
CheckUpdateMac Work_Order_Manager.xlsm

1 Option Explicit
2
3 Sub CheckAndUpdateWO()
4 Dim WORow As Long, LastWORow As Long
5 Dim AssignOn As Date, ChangeOn As Date
6 Dim FilePath As String
7 Dim WOMgrWkBk As Workbook
8 Set WOMgrWkBk = ThisWorkbook
9 With Sheet1
10 LastWORow = .Range("D9999" ).End(xlUp).Row 'Last WO Row
11 For WORow = 17 To LastWORow
12 If .Range("H" & WORow).Value = "Open" Then 'Check Only Open Status
13 AssignOn = .Range("G" & WORow).Value 'Assigned on Date & Time
14 FilePath = .Range("N3" ).Value & "\" & .Range("E" & WORow).Value & "\" &
"Work Order_" & .Range("D" & WORow).Value & ".xlsx"
15 ChangeOn = FileDateTime(FilePath)
16 If AssignOn < ChangeOn Then
17 [Link] (FilePath)
18 With ActiveWorkbook
19 [Link](1).Range("I" & WORow).Value = [Link](1).
Range("B7" ).Value 'Completed On
20 [Link](1).Range("K" & WORow).Value = [Link](1).
Range("A14" ).Value 'Work Peformed
21 End With
22 [Link] False
23 If Dir([Link](1).Range("N3" ).Value & "\Archive" , vbDirectory) =
"" Then MkDir ([Link](1).Range("N3" ).Value & "\Archive" ) 'Create
Archive Folder if needed
24 Name FilePath As [Link](1).Range("N3" ).Value & "\Archive\" & Dir(
FilePath)
25 End If
26 End If
27
28 Next WORow
29 End With
30
31
32 End Sub

10 of 14
Index

A
ActiveWorkbook, 10
AssignOn, 10

C
ChangeOn, 10
CheckAndUpdateWO, 10
Close, 10

D
Dir, 10

E
Explicit, 10

F
FileDateTime, 10
FilePath, 10

L
LastWORow, 10

M
MkDir, 10

N
Name, 10

O
Open, 10

R
Range, 10
Row, 10

S
Sheet1, 10
Sheets, 10

T
ThisWorkbook, 10

V
Value, 10
vbDirectory, 10

W
WOMgrWkBk, 10
Workbook, 10
Workbooks, 10
WORow, 10

X
xlUp, 10

11 of 14
T
WOSaveLoadMacs Work_Order_Manager.xlsm

1 Option Explicit
2
3 Sub WO_CancelNew()
4 If [Link]("D17" ).Value <> Empty Then [Link]("D17" ).Select 'Select First row
in table
5 End Sub
6
7
8 Sub WO_Delete()
9 Dim WORow As Long
10 If [Link]("B5" ).Value <> Empty Then
11 WORow = [Link]("B5" ).Value 'Work Order row
12 [Link](WORow & ":" & WORow).[Link]
13 If WORow <> 17 Then [Link]("D" & WORow - 1).Select
14 End If
15 End Sub
16
17 Sub WO_Load()
18 Dim WORow As Long, WOCol As Long
19 With Sheet1
20 If .Range("B5" ).Value = Empty Then Exit Sub
21 WORow = .Range("B5" ).Value 'WO Row
22 For WOCol = 4 To 11
23 .Range(.Cells(15, WOCol).Value).Value = .Cells(WORow, WOCol).Value 'Update Date
24 Next WOCol
25 .Shapes("CancelNewBtn" ).Visible = msoFalse
26 .Shapes("NewWOBtn" ).Visible = msoCTrue
27 .Shapes("DeleteWOBtn" ).Visible = msoCTrue
28 End With
29 End Sub
30
31 Sub WO_New()
32 With Sheet1
33 .Range("J3:K3,E5:F5,J5:K5,E7:F7,J7:K7,D10:G13,H10:K13" ).ClearContents 'Clears all
associated fields
34 .Shapes("CancelNewBtn" ).Visible = msoCTrue
35 .Shapes("NewWOBtn" ).Visible = msoFalse
36 .Shapes("DeleteWOBtn" ).Visible = msoFalse
37 .Range("B4" ).Value = True 'New Work ORder to True
38 .Range("E3" ).Value = .Range("B6" ).Value 'New WOrk Order #
39 .Range("E7" ).Value = "Open" 'Set New WO Status to Open
40 .Range("J5" ).Value = Now 'Set current date/time
41 .Range("J3" ).Select 'Select First field
42 End With
43 End Sub
44
45 Sub WO_SaveUpdate()
46 Dim WORow As Long, WOCol As Long
47 Dim AssignedTo As String, SharedFolder As String, FileName As String, FilePath As String
48 With Sheet1
49 If .Range("J3" ).Value = Empty Or .Range("E3" ).Value = Empty Or .Range("J5" ).Value =
Empty Then
50 MsgBox "Please fill in the required fields"
51 Exit Sub
52 End If
53
54 If .Range("N3" ).Value = Empty Then
55 MsgBox "Please add in a shared folder location"
56 Exit Sub
57 End If
58
1 2

12 of 14
T
WOSaveLoadMacs Work_Order_Manager.xlsm
1 2
59 If .Range("B4" ).Value = True Then 'new WOrk order
60 WORow = .Range("D99999" ).End(xlUp).Row + 1 'First Avail. Row
61 Else ' Existing Work Order
62 WORow = .Range("B5" ).Value 'Existing Work order Row
63 End If
64
65 For WOCol = 4 To 11
66 .Cells(WORow, WOCol).Value = .Range(.Cells(15, WOCol).Value).Value 'Place values in
WO Row
67 [Link](.Cells(14, WOCol).Value).Value = .Range(.Cells(15, WOCol).Value).Value
'Place Values in WO Template
68 Next WOCol
69 .Range("B4" ).Value = False 'Set new WO to false
70 .Shapes("CancelNewBtn" ).Visible = msoFalse
71 .Shapes("NewWOBtn" ).Visible = msoCTrue
72 .Shapes("DeleteWOBtn" ).Visible = msoCTrue
73 .Range("B5" ).Value = WORow
74
75 'Create/Update Work Order in Shared folder if status is Open
76 If .Range("E7" ).Value = "Open" Then
77 AssignedTo = .Range("J3" ).Value 'Assigned To
78 SharedFolder = .Range("N3" ).Value 'Shared Folder location
79 FileName = "Work Order_" & .Range("E3" ).Value 'File Name Work Order & #
80 If Dir(SharedFolder & "\" & AssignedTo, vbDirectory) = "" Then MkDir (SharedFolder
& "\" & AssignedTo) 'Create Folder if it does not exist
81 FilePath = SharedFolder & "\" & AssignedTo & "\" & FileName & ".xlsx"
82 On Error Resume Next
83 Kill (FilePath)
84 On Error GoTo 0
85 [Link]("A1:B17" ).Copy
86 [Link]
87 [Link](1).Range("A1" ).PasteSpecial xlPasteAll
88 [Link](1).Range("A1" ).PasteSpecial xlPasteColumnWidths
89 [Link] FilePath
90 [Link] False
91 .Range("G" & WORow).Value = Now 'Update Assigned On to Current date & Time
92 End If
93 End With
94 End Sub

13 of 14
Index
xlUp, 13
A
ActiveWorkbook, 13
Add, 13
AssignedTo, 12, 13

C
Cells, 12, 13
ClearContents, 12
Close, 13
Copy, 13

D
Delete, 12
Dir, 13

E
Empty, 12
EntireRow, 12
Explicit, 12

F
FileName, 12, 13
FilePath, 12, 13

K
Kill, 13

M
MkDir, 13
MsgBox, 12
msoCTrue, 12, 13
msoFalse, 12, 13

N
Now, 12, 13

P
PasteSpecial, 13

R
Range, 12, 13
Row, 13

S
SaveAs, 13
Shapes, 12, 13
SharedFolder, 12, 13
Sheet1, 12
Sheet2, 13
Sheets, 13

V
Value, 12, 13
vbDirectory, 13
Visible, 12, 13

W
WO_CancelNew, 12
WO_Delete, 12
WO_Load, 12
WO_New, 12
WO_SaveUpdate, 12
WOCol, 12, 13
Workbooks, 13
WORow, 12, 13

X
xlPasteAll, 13
xlPasteColumnWidths, 13

14 of 14
Thank You!
This source code was created and made available
to help you gain a better understanding of how
VBA is used to create amazing Excel-based
applications.

Thank you so much for your continued shares,


likes and support. It really helps.

You might also like