Excel 2013 VBA Workbook

for
Inventory Tracking
&
Auto Label printing
By
Alex Myers
Introduction:

The following document will give a brief explanation of the Workbook and it use. It will then
provide examples of the VBA (Visual Basic code for Applications) written in the back ground to automate
time stamps, cursor positioning, and label printing for the tracked inventory.

Workbook Description:

The following Excel workbook example is used to scan data from a tracking label on
manufactured inventory parts. Data such as Part Number, Serial Number, and Order Number. As each
part is scanned into the spreadsheet the log is then time stamped and the cursor is relocated to the next
line in the worksheet to begin scanning the next part into the log sheet.

*Screen shot of the Excel Workbook

The “Log Sheet” tab is the main tab created on this sheet and also has a couple of buttons
created to save the file to a specific file location and file name. The second button is a method to
remove a specific part from the inventory without losing the data as well as removing it from the
associated part label tabs that you can see in the screen shot. These tabs are located to the right of the
main “Log Sheet” tab.

At any rate this is my brief description and attempt at sharing this written Excel program. The following
screen shots are of the VBA code in the back ground and of the formulas used in specific cells of the
work sheets.

VBA code for the “Log Sheet” tab shown above:

*VBA Code Screen – Red arrow indicates the worksheet that this code is written for.
VBA Code for “Log Sheet”:

Private Sub Worksheet_Change(ByVal Target As Range)

'Time stamp program for Time stamps of each log sheet entry
'This part of the program also checks to see if the Part worksheet page is full through a cell
' value and calls the Printsheet function.
Dim rCell As Range
Dim rChange As Range
Dim Count1 As Integer
Dim increment As Integer
increment = 6

On Error GoTo ErrHandler

Set rChange = Intersect(Target, Range("c:c"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell > "" Then
With rCell.Offset(0, 1)
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm AM/PM"
End With
Else
rCell.Offset(0, 1).Clear
End If

For Count1 = 7 To 2359 Step increment

If Not Worksheets("17-20469-000").Range("B" & Count1).Value = "" Then
Worksheets("17-20469-000").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-20469-001").Range("B" & Count1).Value = "" Then

Worksheets("17-20469-001").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-20469-002").Range("B" & Count1).Value = "" Then

Worksheets("17-20469-002").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-20469-003").Range("B" & Count1).Value = "" Then

Worksheets("17-20469-003").Range("B" & Count1).Value = 1
 Printsheet Count1
End If

If Not Worksheets("17-19697-006").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-006").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-19697-007").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-007").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-19697-008").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-008").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-19697-009").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-009").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-19697-012").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-012").Range("B" & Count1).Value = 1
Printsheet Count1
End If

If Not Worksheets("17-19697-013").Range("B" & Count1).Value = "" Then

Worksheets("17-19697-013").Range("B" & Count1).Value = 1
Printsheet Count1
End If
Next Count1
Next
End If

'Workbooks("QF_Cowl_Tracking_22819.xlsm").RefreshAll

ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
 MsgBox Err.Description
Resume ExitHandler

End Sub

Sub Printsheet(Count1 As Integer)

Dim Number
Dim PageNum
Number = 1

Do While Number > 0

Select Case Number
Case 1
If Worksheets("17-20469-000").Range("B" & Count1) = "" Then
Number = 2
ElseIf Worksheets("17-20469-000").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-20469-000").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-20469-000 has been printed!")
Worksheets("17-20469-000").Range("B" & Count1).ClearContents
Number = 2
Else
Number = 2
End If
Case 2
If Worksheets("17-20469-001").Range("B" & Count1) = "" Then
Number = 3
ElseIf Worksheets("17-20469-001").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-20469-001").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-20469-001 has been printed!")
Worksheets("17-20469-001").Range("B" & Count1).ClearContents
Number = 3
Else
Number = 3
End If
Case 3
If Worksheets("17-20469-002").Range("B" & Count1) = "" Then
Number = 4
ElseIf Worksheets("17-20469-002").Range("B" & Count1).Value = 1 Then
 PageNum = (Count1 - 1) / 6
Worksheets("17-20469-002").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-20469-002 has been printed!")
Worksheets("17-20469-002").Range("B" & Count1).ClearContents
Number = 4
Exit Do
Else
Number = 4
End If
Case 4
If Worksheets("17-20469-003").Range("B" & Count1) = "" Then
Number = 5
ElseIf Worksheets("17-20469-003").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-20469-003").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-20469-003 has been printed!")
Worksheets("17-20469-003").Range("B" & Count1).ClearContents
Number = 5
Exit Do
Else
Number = 5
End If
Case 5
If Worksheets("17-19697-006").Range("B" & Count1) = "" Then
Number = 6
ElseIf Worksheets("17-19697-006").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-006").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-006 has been printed!")
Worksheets("17-19697-006").Range("B" & Count1).ClearContents
Number = 6
Exit Do
Else
Number = 6
End If
Case 6
If Worksheets("17-19697-007").Range("B" & Count1) = "" Then
Number = 7
ElseIf Worksheets("17-19697-007").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-007").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-007 has been printed!")
Worksheets("17-19697-007").Range("B" & Count1).ClearContents
Number = 7
 Exit Do
Else
Number = 7
End If
Case 7
If Worksheets("17-19697-008").Range("B" & Count1) = "" Then
Number = 8
ElseIf Worksheets("17-19697-008").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-008").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-008 has been printed!")
Worksheets("17-19697-008").Range("B" & Count1).ClearContents
Number = 8
Exit Do
Else
Number = 8
End If
Case 8
If Worksheets("17-19697-009").Range("B" & Count1) = "" Then
Number = 9
ElseIf Worksheets("17-19697-009").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-009").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-009 has been printed!")
Worksheets("17-19697-009").Range("B" & Count1).ClearContents
Number = 9
Exit Do
Else
Number = 9
End If
Case 9
If Worksheets("17-19697-012").Range("B" & Count1) = "" Then
Number = 10
ElseIf Worksheets("17-19697-012").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-012").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-012 has been printed!")
Worksheets("17-19697-012").Range("B" & Count1).ClearContents
Number = 10
Exit Do
Else
Number = 10
End If
Case 10
 If Worksheets("17-19697-013").Range("B" & Count1) = "" Then
Number = 11
ElseIf Worksheets("17-19697-013").Range("B" & Count1).Value = 1 Then
PageNum = (Count1 - 1) / 6
Worksheets("17-19697-013").PrintOut from:=PageNum, to:=PageNum
MsgBox ("Page " & CStr(PageNum) & " of 17-19697-013 has been printed!")
Worksheets("17-19697-013").Range("B" & Count1).ClearContents
Number = 11
Exit Do
Else
Number = 11
End If
Case Else
Number = 0
Exit Do
End Select
Loop
'Workbook_RefreshAll
'End If

End Sub
***************************************************

Screen shot of next section of VBA Code:

*VBA Code for the main workbook as indicated by the red arrow above.

VBA Code:

Private Sub Workbook_Open()

Application.OnTime Now + TimeValue("00:10:00"), "Save1"
End Sub
Next Screen shot of VBA code location:

*VBA code for the first Module #1.

Module #1 VBA Code:

Sub Save_File_Click()

ActiveWorkbook.SaveAs Filename:="N:\Production\Bake Line QF-Cowel tracking\" & Worksheets("Log

sheet").Range("G2").Text & "_" & Worksheets("Log sheet").Range("G3").Text & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False

MsgBox "File has been saved." & vbNewLine & "" & vbNewLine & "Please close Excel Window."

End Sub
*************************************************
Module #2 VBA Code:
Sub Shipping_button_Click()
Dim LSearchValue As String
'Dim c As String

LSearchValue = Application.InputBox(Prompt:="Scan Part Order Number....", Title:="Part To Pull For

individual Shipping.", Type:=1)

With Worksheets("Log Sheet").Range("B:B")

Set c = .Find(LSearchValue, LookIn:=xlValues)
 If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, -1) = c.Offset(0, -1).Value & "P"
'c.Value = 5
Set c = Nothing
Loop While Not c Is Nothing
End If
End With
End Sub
******************************************************

Module #3 VBA Code:

Sub Save1()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="N:\Production\Bake Line QF-Cowel tracking\" & Worksheets("Log
sheet").Range("G2").Text & "_" & Worksheets("Log sheet").Range("G3").Text & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True

Application.OnTime Now + TimeValue("00:10:00"), "Save1"

End Sub
********************************

Formulas:

Formula in the cells of column ‘A’ that searches the data on the “Log Sheet” tab and brings over the
serial number if the part number matches the part number given as the tab’s name.

Array formula as written:

{=IF(ISERROR(INDEX(DataARRAY,SMALL(IF(PartArray="17-20469-000",ROW(PartArray)-4),ROW('Log
Sheet'!1:1)),2)),"",INDEX(DataARRAY,SMALL(IF(PartArray="17-20469-000",ROW(PartArray)-4),ROW('Log
Sheet'!1:1)),2))}
Then the next formula on the worksheets is in column ‘B’ and this formula assist with the VBA code
written to automatically print out a shipping label if 6 of a particular part has been scanned.

Formula for assisting VBA Code:

=IF((LEN(A2) = 7),1,"")

This is again a brief written summary and description of my inventory tracking and label printing
program.

I hope you enjoyed this small document and it may have help you in learning VBA code for Applications.

Thank you,

Alex Myers