Function Azalea_UPC_E(ByVal UPCnumber As String) As String ' UPCTools 16may12 jwhiting ' Copyright 2012 Azalea Software, Inc. All rights reserved. www.azaleabarcodes.com ' Creating a UPC version E in Excel ' The input, UPCnumber, is either the 6 digits from an existing UPC version E symbol, ' or a 10-digit product number with an assumed first digit of "0". ' If your input is 11 digits, strip the leading "0": UPCnumber = Left(UPCnumber, 10) UPC_E_number = Trim(UPCnumber) Dim temp1 As String ' a temporary placeholder Dim temp2 As String ' another temporary placeholder Dim final As String ' output without the check digit or start bar Dim CheckDigit As Integer ' the check digit itself ' Is the input a 6-digit string or a 10-digit string? If Len(UPCnumber) = 6 Then ' OK, we've got a 6-digit input string from an existing version E symbol. Select Case Val(Right(Trim(UPCnumber), 1)) Case 0 temp1 = Left(UPCnumber, 2) + "00000" + Mid(UPCnumber, 3, 3) Case 1 temp1 = Left(UPCnumber, 2) + "10000" + Mid(UPCnumber, 3, 3) Case 2 temp1 = Left(UPCnumber, 2) + "20000" + Mid(UPCnumber, 3, 3) Case 3 temp1 = Left(UPCnumber, 3) + "00000" + Mid(UPCnumber, 4, 2) Case 4 temp1 = Left(UPCnumber, 4) + "00000" + Mid(UPCnumber, 5, 1) Case 5 To 9 temp1 = Left(UPCnumber, 5) + "0000" + Right(UPCnumber, 1) End Select Else ' The input is already 10 digits long. temp1 = UPCnumber End If ' Let's assemble final from manufacturer number and item number according to version E rules. (Arcane terms I know.) If Mid(temp1, 5, 1) <> "0" Then final = Left(temp1, 5) + Right(temp1, 1) ElseIf Mid(temp1, 5, 1) = "0" And Mid(temp1, 4, 1) <> "0" Then final = Left(temp1, 4) + Right(temp1, 1) + "4" ElseIf Mid(temp1, 4, 2) = "00" And Mid(temp1, 3, 1) > "2" Then final = Left(temp1, 3) + Right(temp1, 2) + "3" ElseIf Mid(temp1, 4, 2) = "00" And Mid(temp1, 3, 1) < "3" Then final = Left(temp1, 2) + Right(temp1, 3) + Mid(temp1, 3, 1) End If ' Time to do the check digit calculation. ' Add up the numbers in the odd positions left to right. Multiple the result by 3. ' Add up the numbers in the even positions. Now add the first subtotal to the second. ' The UPC barcode check digit is the single digit number makes the total a multiple of 10. CheckDigit = 3 * (Val(Mid(temp1, 2, 1)) + Val(Mid(temp1, 4, 1)) + Val(Mid(temp1, 6, 1)) + Val(Mid(temp1, 8, 1)) + Val(Mid(temp1, 10, 1))) CheckDigit = CheckDigit + Val(Mid(temp1, 1, 1)) + Val(Mid(temp1, 3, 1)) + Val(Mid(temp1, 5, 1)) + Val(Mid(temp1, 7, 1)) + Val(Mid(temp1, 9, 1)) CheckDigit = 10 - (CheckDigit Mod 10) If CheckDigit = 10 Then CheckDigit = 0 ' Assemble output string with the assumed first digit on "0" and the left guard bars. ' The first number, left(final,1)), always has even parity temp2 = "U|x" + AzaleaEvenBar(Left(final, 1)) ' The variuos parity options for mid(final, 2, 4) depend on the check digit value. Select Case CheckDigit Case "0" ' EEOOO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wU" Case "1" ' EOEOO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w[" Case "2" ' EOOEO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wV" Case "3" ' EOOOE temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wW" Case "4" ' OEEOO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wX" Case "5" ' OOEEO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wY" Case "6" ' OOOEE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wZ" Case "7" ' OEOEO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wu" Case "8" ' OEOOE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w\" Case "9" ' OOEOE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w]" End Select ' The output, Azalea_UPC_E, needs to be formatted in one of Azalea Software's UPC fonts. ' We recommend UPCTallThin at 73 points. ' Excel: B1=Azalea_UPC_E(A1) ' Or put another way, yourContainer.text=Azalea_UPC_E(yourInputString) End Function Public Function AzaleaOddBar(ByVal the As String) As String ' UPCTools 16may12 jwhiting ' Copyright 2012 Azalea Software, Inc. All rights reserved. www.azaleabarcodes.com AzaleaOddBar = Chr(65 + (Val(the))) End Function Public Function AzaleaEvenBar(ByVal the As String) As String ' UPCTools 16may12 jwhiting ' Copyright 2012 Azalea Software, Inc. All rights reserved. www.azaleabarcodes.com AzaleaEvenBar = Chr(75 + Val(the)) End Function