VBA SOURCE

CODE BOOK

FREE Excel Time Picker Pop-

Up: Tutorial

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

DISCORD 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 200 of my BEST Applications

into a SINGLE ZIP File which also includes the "200
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 ..............................................................................................................................................................................................3
VBAProject .....................................................................................................................................................................................3
Documents ..................................................................................................................................................................................3
Sheet1......................................................................................................................................................................................3
(Declarations)........................................................................................................................................................................3
Worksheet_Deactivate [Sub ] ...............................................................................................................................................3
Worksheet_SelectionChange [Sub ] .....................................................................................................................................3
Sheet2......................................................................................................................................................................................4
(Declarations)........................................................................................................................................................................4
Sheet3......................................................................................................................................................................................5
(Declarations)........................................................................................................................................................................5
ThisWorkbook ..........................................................................................................................................................................6
(Declarations)........................................................................................................................................................................6
Modules .......................................................................................................................................................................................7
Time_Picker_Macros ................................................................................................................................................................7
(Declarations)........................................................................................................................................................................7
AMPMSel [Sub ] ....................................................................................................................................................................7
AMSel [Sub ] .........................................................................................................................................................................7
DoneBtn [Sub ]......................................................................................................................................................................7
GrpHrs [Sub ] ........................................................................................................................................................................7
GrpMin [Sub ] ........................................................................................................................................................................7
GrpSet [Sub ] ........................................................................................................................................................................7
HideHrSel [Sub ] ...................................................................................................................................................................8
HideMinSel [Sub ] .................................................................................................................................................................8
HoursDisplay [Sub ] ..............................................................................................................................................................8
MacroLinkRemover [Sub ] .....................................................................................................................................................9
MinDisplay [Sub ] ..................................................................................................................................................................9
PMSel [Sub ] .......................................................................................................................................................................10
ProtTP [Sub ] ......................................................................................................................................................................10
Select1 [Sub ] ......................................................................................................................................................................11
Select10 [Sub ] ....................................................................................................................................................................11
Select11 [Sub ] ....................................................................................................................................................................11
Select12 [Sub ] ....................................................................................................................................................................11
Select2 [Sub ] ......................................................................................................................................................................11
Select3 [Sub ] .....................................................................................................................................................................12
Select4 [Sub ] .....................................................................................................................................................................12
Select5 [Sub ] .....................................................................................................................................................................12
Select6 [Sub ] .....................................................................................................................................................................12
Select7 [Sub ] .....................................................................................................................................................................12
Select8 [Sub ] .....................................................................................................................................................................12
Select9 [Sub ] .....................................................................................................................................................................12
SelectM00 [Sub ] .................................................................................................................................................................13
SelectM05 [Sub ] .................................................................................................................................................................13
SelectM10 [Sub ] .................................................................................................................................................................13
SelectM15 [Sub ] .................................................................................................................................................................13
SelectM20 [Sub ] .................................................................................................................................................................13
SelectM25 [Sub ] .................................................................................................................................................................13
SelectM30 [Sub ] .................................................................................................................................................................14
SelectM35 [Sub ] .................................................................................................................................................................14
SelectM40 [Sub ] .................................................................................................................................................................14
SelectM45 [Sub ] .................................................................................................................................................................14
SelectM50 [Sub ] .................................................................................................................................................................14
SelectM55 [Sub ] .................................................................................................................................................................14
Set10MinInt [Sub ] ..............................................................................................................................................................14
Set15MinInt [Sub ] ..............................................................................................................................................................15
Set5MinInt [Sub ] ................................................................................................................................................................15
SetHideShow [Sub ] ............................................................................................................................................................15
SetThm1 [Sub ] ...................................................................................................................................................................15
SetThm2 [Sub ] ...................................................................................................................................................................15
SetThm3 [Sub ] ...................................................................................................................................................................15
SetThm4 [Sub ] ...................................................................................................................................................................15
SetThm5 [Sub ] ...................................................................................................................................................................16
TPShow [Sub ] ....................................................................................................................................................................16
UnGrpHrs [Sub ] .................................................................................................................................................................16
UnGrpMin [Sub ] .................................................................................................................................................................16
UnGrpSet [Sub ] ..................................................................................................................................................................17

1 of 18
 Table of Contents
UnProtTP [Sub ] ..................................................................................................................................................................17

2 of 18
T
[Link]

1 Option Explicit
2
3 Private Sub Worksheet_Deactivate()
4 Dim TP As Shape
5 On Error Resume Next
6 Set TP = Shapes("TimePickGrp" )
7 On Error GoTo 0
8 If TP Is Nothing Then 'Shape Deleted
9 [Link] = False
10 On Error Resume Next
11 [Link]
12 [Link] = True
13 End If
14 End Sub
15 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
16 Dim TP As Shape
17 On Error Resume Next
18 Set TP = Shapes("TimePickGrp" )
19 On Error GoTo 0
20 If TP Is Nothing Then 'Shape Deleted
21 [Link] = False
22 On Error Resume Next
23 [Link]
24 On Error GoTo 0
25 [Link] = True
26 End If
27 If Not Intersect(Target, Range("K8" )) Is Nothing Then
28 'If Sheet is Protected, add Unprotect Code here such as [Link]
"Password"
29 TPShow
30 Else:
31 Shapes("TimePickGrp" ).Visible = msoFalse
32 End If
33 End Sub
34

3 of 18
 [Link]

1 Option Explicit
2

4 of 18
 [Link]

1 Option Explicit
2

5 of 18
 [Link]

1 Option Explicit
2

6 of 18
T
[Link]

1 Option Explicit
2 Sub AMPMSel()
3 If [Link]("AMPM" ).[Link] = "AM" Then PMSel Else: AMSel
4 End Sub
5 Sub AMSel()
6 UnProtTP
7 With ActiveSheet
8 .Shapes("AMPM" ).[Link] = "AM"
9 .Shapes("AMAct" ).Visible = True
10 .Shapes("AMInact" ).Visible = False
11 .Shapes("PMAct" ).Visible = False
12 .Shapes("PMInact" ).Visible = True
13 End With
14 ProtTP
15 End Sub
16
17 Sub DoneBtn()
18 With ActiveSheet
19 [Link] = .Shapes("HrsDisp" ).[Link] & ":" & .Shapes(
"MinDisp" ).[Link] & " " & .Shapes("AMPM" ).[Link].
Text
20 .Shapes("TimePickGrp" ).Visible = False
21 'SetHideShow
22 End With
23 End Sub
24 Sub GrpHrs()
25 Dim GrpRange, GrpShapes
26 On Error GoTo ExitSub
27 Set GrpShapes = [Link](Array("1Hr" , "2Hr" , "3Hr" , "4Hr" , "5Hr" ,
"6Hr" , "7Hr" , "8Hr" , "9Hr" , "10Hr" , "11Hr" , "12Hr" ))
28 Set GrpRange = [Link]
29 [Link] = "HrsGrp"
30 ExitSub:
31 End Sub
32 Sub GrpMin()
33 Dim GrpRange, GrpShapes
34 On Error GoTo ExitSub
35 Set GrpShapes = [Link](Array("00Min" , "05Min" , "10Min" , "15Min" ,
"20Min" , "25Min" , "30Min" , "35Min" , "40Min" , "45Min" , "50Min" , "55Min" ))
36 Set GrpRange = [Link]
37 [Link] = "MinGrp"
38 ExitSub:
39 End Sub
40 Sub GrpSet()
41 Dim GrpRange, GrpShapes
42 On Error GoTo ExitSub
43 Set GrpShapes = [Link](Array("5Pie1" , "5Pie2" ))
44 Set GrpRange = [Link]
45 [Link] = "5Thm"
46 Set GrpShapes = [Link](Array("4Pie1" , "4Pie2" ))
47 Set GrpRange = [Link]
48 [Link] = "4Thm"
49 Set GrpShapes = [Link](Array("3Pie1" , "3Pie2" ))
50 Set GrpRange = [Link]
51 [Link] = "3Thm"
52 Set GrpShapes = [Link](Array("2Pie1" , "2Pie2" ))
53 Set GrpRange = [Link]
54 [Link] = "2Thm"
55 Set GrpShapes = [Link](Array("1Pie1" , "1Pie2" ))
56 Set GrpRange = [Link]
57 [Link] = "1Thm"
1

7 of 18
T
[Link]
1
58 Set GrpShapes = [Link](Array("5MinPie" , "5MinTxt" ))
59 Set GrpRange = [Link]
60 [Link] = "5MinGrp"
61 Set GrpShapes = [Link](Array("10MinPie" , "10MinTxt" ))
62 Set GrpRange = [Link]
63 [Link] = "10MinGrp"
64 Set GrpShapes = [Link](Array("15MinPie" , "15MinTxt" ))
65 Set GrpRange = [Link]
66 [Link] = "15MinGrp"
67 Set GrpShapes = [Link](Array("SetBack" , "1Thm" , "2Thm" , "3Thm" ,
"4Thm" , "5Thm" , "IntTxt" , "ThmTxt" , "5MinGrp" , "10MinGrp" , "15MinGrp" ))
68 Set GrpRange = [Link]
69 [Link] = "SetGrp"
70 ExitSub:
71 End Sub
72 Sub HideHrSel()
73 With ActiveSheet
74 .Shapes("1Sel" ).Visible = False
75 .Shapes("2Sel" ).Visible = False
76 .Shapes("3Sel" ).Visible = False
77 .Shapes("4Sel" ).Visible = False
78 .Shapes("5Sel" ).Visible = False
79 .Shapes("6Sel" ).Visible = False
80 .Shapes("7Sel" ).Visible = False
81 .Shapes("8Sel" ).Visible = False
82 .Shapes("9Sel" ).Visible = False
83 .Shapes("10Sel" ).Visible = False
84 .Shapes("11Sel" ).Visible = False
85 .Shapes("12Sel" ).Visible = False
86 End With
87 End Sub
88 Sub HideMinSel()
89 With ActiveSheet
90 .Shapes("05MSel" ).Visible = False
91 .Shapes("10MSel" ).Visible = False
92 .Shapes("15MSel" ).Visible = False
93 .Shapes("20MSel" ).Visible = False
94 .Shapes("25MSel" ).Visible = False
95 .Shapes("30MSel" ).Visible = False
96 .Shapes("35MSel" ).Visible = False
97 .Shapes("40MSel" ).Visible = False
98 .Shapes("45MSel" ).Visible = False
99 .Shapes("50MSel" ).Visible = False
100 .Shapes("55MSel" ).Visible = False
101 .Shapes("00MSel" ).Visible = False
102 End With
103 End Sub
104 Sub HoursDisplay()
105 Dim Siz, CurLeft, CurTop As Long
106 With ActiveSheet
107 UnProtTP
108 HideMinSel
109 HideHrSel
110 .Shapes("MinDisp" ).[Link] = RGB(255, 255, 255)
111 .Shapes("HrsDisp" ).[Link] = RGB(255, 0, 0)
112 If [Link] = Empty Then 'Set Default TIme to 12PM
113 .Shapes("HrsDisp" ).[Link] = "12"
114 .Shapes("MinDisp" ).[Link] = "00"
115 .Shapes("AMPM" ).[Link] = "PM"
116 End If
117 .Shapes("MinGrp" ).Visible = False
1 2

8 of 18
T
[Link]
1 2
118 With .Shapes("HrsGrp" )
119 .Visible = True
120 CurLeft = .Left
121 CurTop = .Top
122 For Siz = 180 To 152 Step -4
123 .Width = Siz
124 .Height = Siz
125 .Left = 152 - Siz + CurLeft
126 .Top = 152 - Siz + CurTop
127 [Link] (Now + 0#)
128 Next Siz
129 End With
130 On Error Resume Next
131 .Shapes(.Shapes("HrsDisp" ).[Link] & "Sel" ).Visible = True
132 On Error GoTo 0
133 ProtTP
134 End With
135 End Sub
136 Sub MacroLinkRemover()
137 'PURPOSE: Remove an external workbook reference from all shapes triggering macros
138 'Source: [Link]
139 Dim shp As Shape
140 Dim MacroLink, NewLink As String
141 Dim SplitLink As Variant
142
143 For Each shp In [Link] 'Loop through each shape in worksheet
144
145 'Grab current macro link (if available)
146 On Error GoTo NextShp
147 MacroLink = [Link]
148
149 'Determine if shape was linking to a macro
150 If MacroLink <> "" And InStr(MacroLink, "!" ) <> 0 Then
151 'Split Macro Link at the exclaimation mark (store in Array)
152 SplitLink = Split(MacroLink, "!" )
153
154 'Pull text occurring after exclaimation mark
155 NewLink = SplitLink(1)
156
157 'Remove any straggling apostrophes from workbook name
158 If Right(NewLink, 1) = "'" Then
159 NewLink = Left(NewLink, Len(NewLink) - 1)
160 End If
161
162 'Apply New Link
163 [Link] = NewLink
164 End If
165 NextShp:
166 Next shp
167 End Sub
168
169
170
171
172
173 Sub MinDisplay()
174 Dim Siz, CurLeft, CurTop As Long
175 Dim Inter As String
176 Dim Intg5, Intg10, Intg15 As Integer
177 With ActiveSheet
178 UnProtTP
1 2

9 of 18
T
[Link]
1 2
179 Intg5 = .Shapes("5MinTxt" ).[Link]
180 Intg10 = .Shapes("10MinTxt" ).[Link]
181 Intg15 = .Shapes("15MinTxt" ).[Link]
182 If Intg5 = -1 Then Inter = "5M"
183 If Intg10 = -1 Then Inter = "10M"
184 If Intg15 = -1 Then Inter = "15M"
185
186 HideHrSel
187 .Shapes("HrsDisp" ).[Link] = RGB(255, 255, 255)
188 .Shapes("MInDisp" ).[Link] = RGB(255, 0, 0)
189 .Shapes("HrsGrp" ).Visible = False
190 .Shapes("MinGrp" ).Visible = True
191 If Inter = "10M" Or Inter = "15M" Then .Shapes("05Min" ).Visible = False
192 If Inter = "15M" Then .Shapes("10Min" ).Visible = False
193 If Inter = "10M" Then .Shapes("15Min" ).Visible = False
194 If Inter = "15M" Then .Shapes("20Min" ).Visible = False
195 If Inter = "10M" Or Inter = "15M" Then .Shapes("25Min" ).Visible = False
196 If Inter = "10M" Or Inter = "15M" Then .Shapes("35Min" ).Visible = False
197 If Inter = "15M" Then .Shapes("40Min" ).Visible = False
198 If Inter = "10M" Then .Shapes("45Min" ).Visible = False
199 If Inter = "15M" Then .Shapes("50Min" ).Visible = False
200 If Inter = "10M" Or Inter = "15M" Then .Shapes("55Min" ).Visible = False
201 With .Shapes("MinGrp" )
202 ' .Visible = True
203 CurLeft = .Left
204 CurTop = .Top
205 For Siz = 126 To 152 Step 2
206 .Width = Siz
207 .Height = Siz
208 .Left = 152 - Siz + CurLeft
209 .Top = 152 - Siz + CurTop
210 [Link] (Now + 0#)
211 Next Siz
212 End With
213 On Error Resume Next
214 .Shapes(.Shapes("MinDisp" ).[Link] & "MSel" ).Visible = True
215 On Error GoTo 0
216 ProtTP
217 End With
218 End Sub
219 Sub PMSel()
220 UnProtTP
221 With ActiveSheet
222 .Shapes("AMPM" ).[Link] = "PM"
223 .Shapes("AMAct" ).Visible = False
224 .Shapes("AMInact" ).Visible = True
225 .Shapes("PMAct" ).Visible = True
226 .Shapes("PMInact" ).Visible = False
227 End With
228 ProtTP
229 End Sub
230 Sub ProtTP()
231 Dim GrpRange, GrpShapes
232 On Error GoTo ExitSub
233 Set GrpShapes = [Link](Array("MainBack" , "BackCircle" , "HrsGrp" ,
"8Sel" , _
234 "9Sel" , "10Sel" , "11Sel" , "12Sel" , "1Sel" , "2Sel" , "3Sel" , "4Sel" , "5Sel" ,
_
235 "HrsDisp" , "Colon" , "MinDisp" , "AMPM" , "AMAct" , "PMInact" , "DivLine" ,
"DoneBtn" _
236 , "SettingsBtn" , "6Sel" , "7Sel" , "MinGrp" , "PMAct" , "AMInact" , "00MSel" , _
1

10 of 18
T
[Link]
1
237 "05MSel" , "10MSel" , "15MSel" , "20MSel" , "25MSel" , "30MSel" , "35MSel" ,
"40MSel" , _
238 "45MSel" , "50MSel" , "55MSel" , "SetGrp" ))
239 Set GrpRange = [Link]
240 [Link] = "TimePickGrp"
241 [Link]("TimePickGrp" ).Placement = 2
242 ExitSub:
243 'Add in any Protect sheet code here such as [Link] "Password"
244 '[Link] = True
245 End Sub
246
247 Sub Select1()
248 UnProtTP
249 HideHrSel
250 With ActiveSheet
251 .Shapes("1Sel" ).Visible = True
252 .Shapes("HrsDisp" ).[Link] = "1"
253 MinDisplay
254 End With
255 ProtTP
256 End Sub
257 Sub Select10()
258 UnProtTP
259 HideHrSel
260 With ActiveSheet
261 .Shapes("10Sel" ).Visible = True
262 .Shapes("HrsDisp" ).[Link] = "10"
263 MinDisplay
264 End With
265 ProtTP
266 End Sub
267 Sub Select11()
268 UnProtTP
269 HideHrSel
270 With ActiveSheet
271 .Shapes("11Sel" ).Visible = True
272 .Shapes("HrsDisp" ).[Link] = "11"
273 MinDisplay
274 End With
275 ProtTP
276 End Sub
277 Sub Select12()
278 UnProtTP
279 HideHrSel
280 With ActiveSheet
281 .Shapes("12Sel" ).Visible = True
282 .Shapes("HrsDisp" ).[Link] = "12"
283 MinDisplay
284 End With
285 ProtTP
286 End Sub
287 Sub Select2()
288 UnProtTP
289 HideHrSel
290 With ActiveSheet
291 .Shapes("2Sel" ).Visible = True
292 .Shapes("HrsDisp" ).[Link] = "2"
293 If .Shapes("HrsGrp" ).Visible = True Then MinDisplay
294 End With
295 ProtTP
296 End Sub

11 of 18
T
[Link]

297 Sub Select3()

298 UnProtTP
299 HideHrSel
300 With ActiveSheet
301 .Shapes("3Sel" ).Visible = True
302 .Shapes("HrsDisp" ).[Link] = "3"
303 MinDisplay
304 End With
305 ProtTP
306 End Sub
307 Sub Select4()
308 UnProtTP
309 HideHrSel
310 With ActiveSheet
311 .Shapes("4Sel" ).Visible = True
312 .Shapes("HrsDisp" ).[Link] = "4"
313 MinDisplay
314 End With
315 ProtTP
316 End Sub
317 Sub Select5()
318 UnProtTP
319 HideHrSel
320 With ActiveSheet
321 .Shapes("5Sel" ).Visible = True
322 .Shapes("HrsDisp" ).[Link] = "5"
323 MinDisplay
324 End With
325 ProtTP
326 End Sub
327 Sub Select6()
328 UnProtTP
329 HideHrSel
330 With ActiveSheet
331 .Shapes("6Sel" ).Visible = True
332 .Shapes("HrsDisp" ).[Link] = "6"
333 MinDisplay
334 End With
335 ProtTP
336 End Sub
337 Sub Select7()
338 UnProtTP
339 HideHrSel
340 With ActiveSheet
341 .Shapes("7Sel" ).Visible = True
342 .Shapes("HrsDisp" ).[Link] = "7"
343 MinDisplay
344 End With
345 ProtTP
346 End Sub
347 Sub Select8()
348 UnProtTP
349 HideHrSel
350 With ActiveSheet
351 .Shapes("8Sel" ).Visible = True
352 .Shapes("HrsDisp" ).[Link] = "8"
353 MinDisplay
354 End With
355 ProtTP
356 End Sub
357 Sub Select9()
1

12 of 18
T
[Link]
1
358 UnProtTP
359 HideHrSel
360 With ActiveSheet
361 .Shapes("9Sel" ).Visible = True
362 .Shapes("HrsDisp" ).[Link] = "9"
363 MinDisplay
364 End With
365 ProtTP
366 End Sub
367 Sub SelectM00()
368 UnProtTP
369 HideMinSel
370 With ActiveSheet
371 .Shapes("00MSel" ).Visible = True
372 .Shapes("MinDisp" ).[Link] = "00"
373 End With
374 ProtTP
375 End Sub
376 Sub SelectM05()
377 UnProtTP
378 HideMinSel
379 With ActiveSheet
380 .Shapes("05MSel" ).Visible = True
381 .Shapes("MinDisp" ).[Link] = "05"
382 End With
383 ProtTP
384 End Sub
385 Sub SelectM10()
386 UnProtTP
387 HideMinSel
388 With ActiveSheet
389 .Shapes("10MSel" ).Visible = True
390 .Shapes("MinDisp" ).[Link] = "10"
391 End With
392 ProtTP
393 End Sub
394 Sub SelectM15()
395 UnProtTP
396 HideMinSel
397 With ActiveSheet
398 .Shapes("15MSel" ).Visible = True
399 .Shapes("MinDisp" ).[Link] = "15"
400 End With
401 ProtTP
402 End Sub
403 Sub SelectM20()
404 UnProtTP
405 HideMinSel
406 With ActiveSheet
407 .Shapes("20MSel" ).Visible = True
408 .Shapes("MinDisp" ).[Link] = "20"
409 End With
410 ProtTP
411 End Sub
412 Sub SelectM25()
413 UnProtTP
414 HideMinSel
415 With ActiveSheet
416 .Shapes("25MSel" ).Visible = True
417 .Shapes("MinDisp" ).[Link] = "25"
418 End With
1

13 of 18
T
[Link]
1
419 ProtTP
420 End Sub
421 Sub SelectM30()
422 UnProtTP
423 HideMinSel
424 With ActiveSheet
425 .Shapes("30MSel" ).Visible = True
426 .Shapes("MinDisp" ).[Link] = "30"
427 End With
428 ProtTP
429 End Sub
430 Sub SelectM35()
431 UnProtTP
432 HideMinSel
433 With ActiveSheet
434 .Shapes("35MSel" ).Visible = True
435 .Shapes("MinDisp" ).[Link] = "35"
436 End With
437 ProtTP
438 End Sub
439 Sub SelectM40()
440 UnProtTP
441 HideMinSel
442 With ActiveSheet
443 .Shapes("40MSel" ).Visible = True
444 .Shapes("MinDisp" ).[Link] = "40"
445 End With
446 ProtTP
447 End Sub
448 Sub SelectM45()
449 UnProtTP
450 HideMinSel
451 With ActiveSheet
452 .Shapes("45MSel" ).Visible = True
453 .Shapes("MinDisp" ).[Link] = "45"
454 End With
455 ProtTP
456 End Sub
457 Sub SelectM50()
458 UnProtTP
459 HideMinSel
460 With ActiveSheet
461 .Shapes("50MSel" ).Visible = True
462 .Shapes("MinDisp" ).[Link] = "50"
463 End With
464 ProtTP
465 End Sub
466 Sub SelectM55()
467 UnProtTP
468 HideMinSel
469 With ActiveSheet
470 .Shapes("55MSel" ).Visible = True
471 .Shapes("MinDisp" ).[Link] = "55"
472 End With
473 ProtTP
474 End Sub
475
476 Sub Set10MinInt()
477 With ActiveSheet
478 .Shapes("10MinTxt" ).[Link] = RGB(140, 58, 58)
479 .Shapes("10MinTxt" ).[Link] = msoCTrue
1 2

14 of 18
T
[Link]
1 2
480 .Shapes("5MinTxt" ).[Link] = msoFalse
481 .Shapes("15MinTxt" ).[Link] = msoFalse
482 End With
483 MinDisplay
484 SelectM00
485 End Sub
486
487 Sub Set15MinInt()
488 With ActiveSheet
489 .Shapes("15MinTxt" ).[Link] = RGB(140, 58, 58)
490 .Shapes("15MinTxt" ).[Link] = msoCTrue
491 .Shapes("10MinTxt" ).[Link] = msoFalse
492 .Shapes("5MinTxt" ).[Link] = msoFalse
493 End With
494 MinDisplay
495 SelectM00
496 End Sub
497 Sub Set5MinInt()
498 With ActiveSheet
499 .Shapes("5MinTxt" ).[Link] = RGB(140, 58, 58)
500 .Shapes("5MinTxt" ).[Link] = msoCTrue
501 .Shapes("10MinTxt" ).[Link] = msoFalse
502 .Shapes("15MinTxt" ).[Link] = msoFalse
503 End With
504 MinDisplay
505 SelectM00
506 End Sub
507
508 Sub SetHideShow()
509 With ActiveSheet
510 UnProtTP
511 If .Shapes("SetGrp" ).Visible = False Then
512 .Shapes("SetGrp" ).Visible = msoCTrue
513 Else
514 .Shapes("SetGrp" ).Visible = False
515 End If
516 End With
517
518 ProtTP
519 End Sub
520
521 Sub SetThm1()
522 [Link](Array("SetBack" , "MainBack" )).[Link] = RGB(64, 64,
64)
523 [Link]("BackCircle" ).[Link] = RGB(54, 54, 54)
524 End Sub
525 Sub SetThm2()
526 [Link](Array("SetBack" , "MainBack" )).[Link] = RGB(55, 96,
146)
527 [Link]("BackCircle" ).[Link] = RGB(37, 64, 97)
528 End Sub
529 Sub SetThm3()
530 [Link](Array("SetBack" , "MainBack" )).[Link] = RGB(119, 147
, 60)
531 [Link]("BackCircle" ).[Link] = RGB(79, 98, 40)
532 End Sub
533 Sub SetThm4()
534 [Link](Array("SetBack" , "MainBack" )).[Link] = RGB(96, 74,
123)
535 [Link]("BackCircle" ).[Link] = RGB(64, 49, 82)
536 End Sub

15 of 18
T
[Link]

537 Sub SetThm5()

538 [Link](Array("SetBack" , "MainBack" )).[Link] = RGB(49, 133,
156)
539 [Link]("BackCircle" ).[Link] = RGB(33, 89, 104)
540 End Sub
541 Sub TPShow()
542 Dim SelCell As Range
543 Dim Hr As Long
544 'On Error GoTo NoTP
545 'If Sheet is Protected, add Unprotect Code here such as [Link] "Password"
546 With [Link]("TimePickGrp" )
547 Set SelCell = Selection
548 .Visible = msoCTrue
549 ' On Error Resume Next
550 .Left = [Link]
551 .Top = [Link](1, 0).Top
552 ' On Error GoTo 0
553 End With
554 UnProtTP
555 HideHrSel
556 HideMinSel
557 'Check for Links from another workbook
558 UnGrpSet
559 If InStr([Link]("5Pie1" ).OnAction, "!" ) <> 0 Then 'Run Workbook Link
Remover
560 UnGrpHrs
561 UnGrpMin
562 MacroLinkRemover
563 GrpHrs
564 GrpMin
565 GrpSet
566 Else:
567 GrpSet
568 End If
569 If [Link] <> Empty Then Hr = Format([Link], "hh" )
570 If Hr >= 13 Then Hr = Hr - 12
571 If Hr = 0 Then Hr = 12
572
573 If [Link] <> Empty Then [Link]("HrsDisp" ).[Link]
= Hr
574 If [Link] <> Empty Then [Link]("MInDisp" ).[Link]
= Right(Format([Link], "h:mm" ), 2)
575 If [Link] <> Empty Then [Link]("AMPM" ).[Link] =
Format([Link], "AM/PM" )
576 [Link]("SetGrp" ).Visible = msoFalse
577 HoursDisplay
578 ProtTP
579 'If Sheet is Protected, Add Protection Code here such as [Link] "Password"
580 Exit Sub
581 NoTP:
582 MsgBox "The Time Picker has been removed from this sheet. Please copy the entire Time
Picker from another sheet and paste it into this sheet"
583 'If Sheet is Protected, Add Protection Code here such as [Link] "Password"
584 End Sub
585
586 Sub UnGrpHrs()
587 On Error Resume Next
588 [Link]("HrsGrp" ).Ungroup
589 On Error GoTo 0
590 End Sub
591

16 of 18
T
[Link]

592 Sub UnGrpMin()

593 On Error Resume Next
594 [Link]("MinGrp" ).Ungroup
595 On Error GoTo 0
596 End Sub
597 Sub UnGrpSet()
598 On Error Resume Next
599 [Link]("SetGrp" ).Ungroup
600 [Link]("5Thm" ).Ungroup
601 [Link]("4Thm" ).Ungroup
602 [Link]("3Thm" ).Ungroup
603 [Link]("2Thm" ).Ungroup
604 [Link]("1Thm" ).Ungroup
605 [Link]("5MinGrp" ).Ungroup
606 [Link]("10MinGrp" ).Ungroup
607 [Link]("15MinGrp" ).Ungroup
608 On Error GoTo 0
609 End Sub
610 Sub UnProtTP()
611 On Error Resume Next
612 [Link]("TimePickGrp" ).Ungroup
613 On Error GoTo 0
614 'Add in any Unprotect sheet code here such as [Link] "Password"
615 '[Link] = False
616 End Sub

17 of 18
 Index
NextShp, 9
_ NoTP, 16 U
_, 10, 11 Now, 9, 10 Undo, 3
Ungroup, 16, 17
A O UnGrpHrs, 16
ActiveCell, 7, 8, 16 Offset, 16 UnGrpMin, 16, 17
ActiveSheet, 7-17 OnAction, 9, 16 UnGrpSet, 16, 17
AMPMSel, 7 UnProtTP, 7-17
AMSel, 7 P
Application, 3, 9, 10 Placement, 11 V
Array, 7, 8, 10, 15, 16 PMSel, 7, 10 Value, 7, 8, 16
ProtTP, 7, 9-16 Visible, 3, 7-16
C
Characters, 7-14, 16 R W
CurLeft, 8-10 Range, 3, 7, 8, 10, 15, 16 Wait, 9, 10
CurTop, 8-10 RGB, 8, 10, 14-16 Width, 9, 10
Right, 9, 16 Worksheet_Deactivate, 3
D Worksheet_SelectionChange, 3
DoneBtn, 7 S
SelCell, 16
E Select1, 11
Empty, 8, 16 Select10, 11
EnableEvents, 3 Select11, 11
ExitSub, 7, 8, 10, 11 Select12, 11
Explicit, 3-7 Select2, 11
Select3, 12
F Select4, 12
Fill, 8, 10, 14-16 Select5, 12
Font, 8, 10 Select6, 12
ForeColor, 8, 10, 14-16 Select7, 12
Format, 16 Select8, 12
Select9, 12
G Selection, 16
Group, 7, 8, 11 SelectM00, 13, 15
GrpHrs, 7, 16 SelectM05, 13
GrpMin, 7, 16 SelectM10, 13
GrpRange, 7, 8, 10, 11 SelectM15, 13
GrpSet, 7, 16 SelectM20, 13
GrpShapes, 7, 8, 10, 11 SelectM25, 13
SelectM30, 14
H SelectM35, 14
Height, 9, 10 SelectM40, 14
HideHrSel, 8, 10-13, 16 SelectM45, 14
HideMinSel, 8, 13, 14, 16 SelectM50, 14
HoursDisplay, 8, 16 SelectM55, 14
Hr, 16 Set10MinInt, 14
Set15MinInt, 15
I Set5MinInt, 15
InStr, 9, 16 SetHideShow, 15
Inter, 9, 10 SetThm1, 15
Intersect, 3 SetThm2, 15
Intg10, 9, 10 SetThm3, 15
Intg15, 9, 10 SetThm4, 15
Intg5, 9, 10 SetThm5, 16
Shape, 3, 9
L Shapes, 3, 7-17
Left, 9, 10, 16 shp, 9
Len, 9 Siz, 8-10
Split, 9
M SplitLink, 9
MacroLink, 9
MacroLinkRemover, 9, 16 T
MinDisplay, 9, 11-13, 15 Target, 3
MsgBox, 16 Text, 7-14, 16
msoCTrue, 14-16 TextFrame, 7-14, 16
msoFalse, 3, 15, 16 TextFrame2, 8, 10
TextRange, 8, 10
N Top, 9, 10, 16
Name, 7, 8, 11 TP, 3
NewLink, 9 TPShow, 3, 16

18 of 18
 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.