VBA SOURCE
CODE BOOK
Learn How To Create Excel
Forms And Map Them To
Tables From Scratch
[GREAT FOR VBA
BEGINNERS]
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
Prod_List ..................................................................................................................................................................................2
(Declarations)........................................................................................................................................................................2
Products ...................................................................................................................................................................................4
(Declarations)........................................................................................................................................................................4
Worksheet_Change [Sub ] ....................................................................................................................................................4
Sheet3......................................................................................................................................................................................6
(Declarations)........................................................................................................................................................................6
ThisWorkbook ..........................................................................................................................................................................8
(Declarations)........................................................................................................................................................................8
Modules .....................................................................................................................................................................................10
Prod_Macros ..........................................................................................................................................................................10
(Declarations)......................................................................................................................................................................10
Product_AddNew [Sub ] ......................................................................................................................................................10
Product_Delete [Sub ] .........................................................................................................................................................10
Product_Load [Sub ] ...........................................................................................................................................................10
Product_SaveUpdate [Sub ] ................................................................................................................................................10
Prod_Pictures.........................................................................................................................................................................13
(Declarations)......................................................................................................................................................................13
Browse_For_Picture [Sub ] .................................................................................................................................................13
Prod_DisplayPicture [Sub ] .................................................................................................................................................13
1 of 14
Prod_List Data_Mapping_Masterclass.xlsm
1 Option Explicit
2
2 of 14
Index
E
Explicit, 2
3 of 14
T
Products Data_Mapping_Masterclass.xlsm
1 Option Explicit
2
3 Private Sub Worksheet_Change(ByVal Target As Range)
4 If Not Intersect(Target, Range("E5" )) Is Nothing And Range("E5" ).Value <> Empty And
Range("B4" ).Value = False And Range("B5" ).Value <> Empty Then Product_Load
5 If Not Intersect(Target, Range("E7:L11" )) Is Nothing And Range("B4" ).Value = False And
Range("B6" ).Value <> Empty Then
6 Dim ProdRow As Long, ProdCol As Long
7 ProdRow = Range("B6" ).Value 'Product Row
8 'ProdCol = [Link](1, 0).Value 'Product Column
9 ProdCol = [Link](0, 10).Value 'Product Column
10 If IsNumeric(ProdCol) = True And ProdCol <> 0 Then
11 Prod_List.Cells(ProdRow, ProdCol).Value = [Link]
12 If Not Intersect(Target, Range("E7" )) Is Nothing And Range("E7" ).Value <> Empty
Then
13 Range("B4" ).Value = True
14 Range("E5" ).Value = Range("E7" ).Value 'Update Product Name
15 Range("B4" ).Value = False
16 End If
17 End If
18
19
20 End If
21
22 End Sub
4 of 14
Index
C
Cells, 4
E
Empty, 4
Explicit, 4
I
Intersect, 4
IsNumeric, 4
O
Offset, 4
P
Prod_List, 4
ProdCol, 4
ProdRow, 4
Product_Load, 4
R
Range, 4
T
Target, 4
V
Value, 4
W
Worksheet_Change, 4
5 of 14
Sheet3 Data_Mapping_Masterclass.xlsm
1 Option Explicit
2
6 of 14
Index
E
Explicit, 6
7 of 14
ThisWorkbook Data_Mapping_Masterclass.xlsm
1 Option Explicit
2
8 of 14
Index
E
Explicit, 8
9 of 14
T
Prod_Macros Data_Mapping_Masterclass.xlsm
1 Option Explicit
2 Dim ProdRow As Long, ProdCol As Long
3 Sub Product_AddNew()
4 [Link]("E5,E7,E9,E11,H5,H7,H9,H11,K11,L11" ).ClearContents
5 On Error Resume Next
6 [Link]("ProdPic" ).Delete
7 On Error GoTo 0
8 End Sub
9
10
11 Sub Product_Delete()
12 With Products
13 If .Range("B6" ).Value = Empty Then
14 MsgBox "Please select a correct product to delete"
15 Exit Sub
16 End If
17 If MsgBox("Are you sure you want to delete this product?" , vbYesNo, "Delete Product" )
= vbNo Then Exit Sub
18 ProdRow = .Range("B6" ).Value 'Product Row
19 Prod_List.Range(ProdRow & ":" & ProdRow).[Link]
20 On Error Resume Next
21 .Shapes("ProdPic" ).Delete
22 On Error GoTo 0
23 Product_AddNew
24 End With
25 End Sub
26
27 Sub Product_Load()
28 With Products
29 If .Range("B5" ).Value = Empty Then
30 MsgBox "Please select a correct product"
31 Exit Sub
32 End If
33 .Range("B4" ).Value = True 'Set Prod Load True
34 ProdRow = .Range("B5" ).Value 'Product Row
35 For ProdCol = 1 To 9
36 .Range(Prod_List.Cells(1, ProdCol).Value).Value = Prod_List.Cells(ProdRow, ProdCol).
Value
37 Next ProdCol
38 Prod_DisplayPicture
39 .Range("B4" ).Value = False 'Set Prod Load False
40 End With
41 End Sub
42 Sub Product_SaveUpdate()
43 With Products
44 If .Range("E7" ).Value = Empty Then
45 MsgBox "Please enter a product name before saving"
46 Exit Sub
47 End If
48 If .Range("B6" ).Value = Empty Then 'New Product
49 .Range("H5" ).Value = .Range("B7" ).Value 'Product ID
50 ProdRow = Prod_List.Range("A99999" ).End(xlUp).Row + 1
51 Prod_List.Range("A" & ProdRow).Value = .Range("B7" ).Value 'Product ID
52 Else 'Existing Product
53 ProdRow = .Range("B6" ).Value 'Product Row
54 End If
55 For ProdCol = 2 To 9
56 Prod_List.Cells(ProdRow, ProdCol).Value = .Range(Prod_List.Cells(1, ProdCol).Value).
Value 'Add Data to Product List
57 Next ProdCol
58 .Range("B4" ).Value = True 'Product Update to true
1 2
10 of 14
T
Prod_Macros Data_Mapping_Masterclass.xlsm
1 2
59 .Range("E5" ).Value = .Range("E7" ).Value 'Product Name in Drop down list
60 .Range("B4" ).Value = False 'Product Update to False
61 End With
62 End Sub
11 of 14
Index
C
Cells, 10
ClearContents, 10
D
Delete, 10
E
Empty, 10
EntireRow, 10
Explicit, 10
M
MsgBox, 10
P
Prod_DisplayPicture, 10
Prod_List, 10
ProdCol, 10
ProdRow, 10
Product_AddNew, 10
Product_Delete, 10
Product_Load, 10
Product_SaveUpdate, 10
Products, 10
R
Range, 10, 11
Row, 10
S
Shapes, 10
V
Value, 10, 11
vbNo, 10
vbYesNo, 10
X
xlUp, 10
12 of 14
T
Prod_Pictures Data_Mapping_Masterclass.xlsm
1 Option Explicit
2 Dim PicPath As String
3
4 Sub Browse_For_Picture()
5 Dim PicFile As FileDialog
6 Set PicFile = [Link](msoFileDialogFilePicker)
7 With PicFile
8 .Title = "Select A Product Picture"
9 .[Link] "All Picture Files" , "*.jpg, *.jpeg,*gif,*.png,*.bmp" , 1
10 If .Show <> -1 Then GoTo NoSelection
11 PicPath = .SelectedItems(1)
12 [Link]("L11" ).Value = PicPath 'Set Picture Path
13 Prod_DisplayPicture 'Run Macro to display picture
14 NoSelection:
15 End With
16 End Sub
17
18 Sub Prod_DisplayPicture()
19 With Products
20 On Error Resume Next
21 .Shapes("ProdPic" ).Delete
22 On Error GoTo 0
23 If .Range("L11" ).Value = Empty Then Exit Sub
24 PicPath = .Range("L11" ).Value 'Picture Path
25 If Dir(PicPath, vbDirectory) = "" Then Exit Sub
26 .[Link](PicPath).Name = "ProdPic" 'Add Picture & Assign Name
27 With .Shapes("ProdPic" )
28 .LockAspectRatio = msoCTrue
29 If .Width > .Height Then
30 .Width = 90
31 Else
32 .Height = 70
33 End If
34 .Left = [Link]("J5" ).Left + ([Link]("J:K" ).Width - .Width) / 2
'Left Pos
35 .Top = [Link]("J5" ).Top + ([Link]("5:10" ).Height - .Height) / 2
'Top Pos
36 End With
37
38
39 End With
40 End Sub
13 of 14
Index
A
Add, 13
Application, 13
B
Browse_For_Picture, 13
D
Delete, 13
Dir, 13
E
Empty, 13
Explicit, 13
F
FileDialog, 13
Filters, 13
H
Height, 13
I
Insert, 13
L
Left, 13
LockAspectRatio, 13
M
msoCTrue, 13
msoFileDialogFilePicker, 13
N
Name, 13
NoSelection, 13
P
PicFile, 13
PicPath, 13
Pictures, 13
Prod_DisplayPicture, 13
Products, 13
R
Range, 13
S
SelectedItems, 13
Shapes, 13
Show, 13
T
Title, 13
Top, 13
V
Value, 13
vbDirectory, 13
W
Width, 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.