These are from

http://upcdata.info/?action=a2e and work very well. UPC can be entered by hand (in quotes to preserve leading zeros) or a cell reference used.

Public Function UPCA2UPCE(ByVal UPCA As String) As String

'

' Convert UPC-A to UPC-E format

'

' Written by Glenn J. Schworak (

www.schworak.com)

'

Dim ValidDigits As String

Dim Mfg As String

Dim Prod As String

Dim x As Integer

If Len(UPCA) <> 12 Or (Left(UPCA, 1) <> "0" And Left(UPCA, 1) <> "1") Or _

InStr(1, Mid(UPCA, 5, 8), "0000") < 1 Then

UPCA2UPCE = "INVALID"

Else

Mfg = Mid(UPCA, 2, 5)

Prod = Mid(UPCA, 7, 5)

If Right(Mfg, 3) = "000" Or Right(Mfg, 3) = "100" Or Right(Mfg, 3) = "200" Then

ValidDigits = Left(Mfg, 2) & Right(Prod, 3) & Mid(Mfg, 3, 1)

ElseIf Right(Mfg, 2) = "00" Then

ValidDigits = Left(Mfg, 3) & Right(Prod, 2) & "3"

ElseIf Right(Mfg, 1) = "0" Then

ValidDigits = Left(Mfg, 4) & Right(Prod, 1) & "4"

Else

ValidDigits = Left(Mfg, 5) & Right(Prod, 1)

End If

UPCA2UPCE = Left(UPCA, 1) & ValidDigits & Right(UPCA, 1)

End If

End Function

Public Function UPCE2UPCA(ByVal UPCE As String) As String

'

' Convert UPC-E to UPC-A format

'

' Written by Glenn J. Schworak (

www.schworak.com)

'

Dim ValidDigits As String

Dim Mfg As String

Dim Prod As String

If Len(UPCE) <> 8 Or (Left(UPCE, 1) <> "0" And Left(UPCE, 1) <> "1") Then

'

' Return INVALID instead of a UPC-A code

'

UPCE2UPCA = "INVALID"

Else

'

' Convert the UPC-E to UPC-A

'

ValidDigits = Mid(UPCE, 2, 6)

Select Case Right(ValidDigits, 1)

Case "0"

Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"

Prod = "00" & Mid(ValidDigits, 3, 3)

Case "1"

Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"

Prod = "00" & Mid(ValidDigits, 3, 3)

Case "2"

Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"

Prod = "00" & Mid(ValidDigits, 3, 3)

Case "3"

Mfg = Left(ValidDigits, 3) & "00"

Prod = "000" & Mid(ValidDigits, 4, 2)

Case "4"

Mfg = Left(ValidDigits, 4) & "0"

Prod = "0000" & Mid(ValidDigits, 6, 1)

Case Else

Mfg = Left(ValidDigits, 5)

Prod = "0000" & Mid(ValidDigits, 6, 1)

End Select

'

' Return the 12 digit UPC-A code

'

UPCE2UPCA = Left(UPCE, 1) & Mfg & Prod & Right(UPCE, 1)

End If

End Function