Convert UPC-E to UPC-A? Truncated UPCs

U

unc2plo

Board Regular
Joined
Mar 18, 2002
Messages
148
I am bumping this from the Access Board to the Excel board. I posted in the wrong one by accident.



I am comparing the UPCs of grocery items between two lists. I am running into an issue with one list having a truncated UPC, so I am not getting many mathces.

Pillsbury 8 oz Crescent Rolls is one example. The full UPC is 1800000401. One list has the full UPC, and the other one has 184010.

Is there any way anyone knows of to normalize the UPCs up to the full UPC, or down to the truncated version?

Thanks,
unc2plo
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
R

RalphA

Well-known Member
Joined
May 14, 2003
Messages
3,829
Assuming your data is in two columns, say "Pillsbury 8 oz Crescent Rolls" is in B2, and the UPC number is in C2, you can solve your problem in the following manner. l will post a simple example.
B2 has Pillsbury, C2 has 1234 (in this example, the UPC code has only four digits)
B3 has Colgate, C3 has 3323
B4 has Pillsbury, C4 has 13
B5 has Pillsbury, C5 has 34
B6 has Aunt, C6 has 5312

In a convenient area, say F2:G3, enter the full list of items and UPC numbers, thus:
F1 ITEM G1 UPC #
F2 Aunt G2 5312
F3 Colgate G3 3323
F4 Pillsbury G4 1234
If not in alphaabetic order by ITEM, sort the table that way.

Now, delete the data in column C, and substitute this:
C2 =VLOOKUP(B2,F$2:G$4,2)
and copy down. Column C now has all the correct UPC numbers.
 
Upvote 0
J

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
unc2plo<SCRIPT type=text/javascript> vbmenu_register("postmenu_1618782", true); </SCRIPT>

Can you post few example and required results?
 
Upvote 0
J

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
UDF
1) hit Alt + F11 to open vbe
2) go to [Insert] - [Module] then paste the code onto the right pane
3) hit Alt + F11 again to get back to Excel
Use in cell like
=unc(A1,$B$1:$B$100)
where A1 holds truncated UPC and B1:B100 holds complete UPC
Hope this works...
Code: 
Function unc(txt As String, rng As Range) As String
Dim a, e, myPtn As String
a = rng.Value
With CreateObject("VBScript.RegExp")
    .Pattern = "(.)"
    .Global = True
    myPtn = .replace(txt, "*$1")
    .Pattern = "^" & Mid$(myPtn,2) & "$"
    .Global = False
    For Each e In a
        If .test(e) Then
            unc = e
            Exit For
        End If
    Next
End With
End Function
 
Upvote 0
J

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Correction
Rich (BB code): 
    myPtn = .replace(txt, "*$1")
    .Pattern = "^" & Mid$(myPtn,2) & "$"
should be
Rich (BB code): 
    myPtn = .replace(txt, "$1*")
    .Pattern = "^" & myPtn & "$"
 
Upvote 0
J

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Correction again
Rich (BB code): 
    myPtn = .replace(txt, "$1*")
should be
Rich (BB code): 
    myPtn = .replace(txt, "$1{1,}")
 
Upvote 0
W

wolftamer

New Member
Joined
Aug 9, 2010
Messages
1
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
 
Last edited:
Upvote 0
D

dgates12

New Member
Joined
Nov 8, 2011
Messages
1
wolftamer said:
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
Click to expand...

Sorry, but totally stupid newbie question here. I've got a list of UPC-E cells in column F; how do I modify this code to read the cells in column F and populate the UPC-A in column G? Thanks!
 
Upvote 0
M

MrNedF

New Member
Joined
Feb 22, 2018
Messages
4
wolftamer said:
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
Click to expand...
I know this is an old thread but I think I found an error in the code above.

If you run 02345147 through the UPCE2UPCA function it returns 023450000047 but the correct result should be 023450000017. To test my theory if you run 023450000047 through UPCA2UPCE the result is
01234447 and 023450000017 returns 02345147 (the correct result).

To fix the function you have to change;

Case "4"
Mfg = Left(ValidDigits, 4) & "0"
Prod = "0000" & Mid(ValidDigits, 6, 1)

To

Case "4"
Mfg = Left(ValidDigits, 4) & "0"
Prod = "0000" & Mid(ValidDigits, 5, 1)

NedF
 
Upvote 0
N

Norry

New Member
Joined
Jan 19, 2022
Messages
1
Office Version
  1. 2010
Platform
  1. Windows
I know this is old, but this may help someone out. Formula based. It reads Column A Row 2 (leaving space for header). You can just change every instance of A2 to whatever your target is in the formula.
This also assumes UPC-E is formatted to 6 digits with no leading 0 and no check digit. If your data has those you can just make a column that formats to remove them and read from that.
These do not add a check digit, just FYI.

This one has a leading 0 on the UPC-A:
=IF(RIGHT(A2,1)*1<3,0&LEFT(A2,2)&RIGHT(A2,1)&0&0&0&0&MID(A2,3,3),IF(RIGHT(A2,1)*1=3,0&LEFT(A2,3)&0&0&0&0&0&RIGHT(A2,2),IF(RIGHT(A2,1)*1=4,0&LEFT(A2,4)&0&0&0&0&0&MID(A2,5,1),IF(RIGHT(A2,1)*1>4,0&LEFT(A2,5)&0&0&0&0&RIGHT(A2,1),"ERROR"))))

This one does not have a leading 0 on the UPC-A:
=IF(RIGHT(A2,1)*1<3,LEFT(A2,2)&RIGHT(A2,1)&0&0&0&0&MID(A2,3,3),IF(RIGHT(A2,1)*1=3,LEFT(A2,3)&0&0&0&0&0&RIGHT(A2,2),IF(RIGHT(A2,1)*1=4,LEFT(A2,4)&0&0&0&0&0&MID(A2,5,1),IF(RIGHT(A2,1)*1>4,LEFT(A2,5)&0&0&0&0&RIGHT(A2,1),"ERROR"))))

It's worked for me, and hopefully will help someone needing it as a formula.
If anyone finds an error with it, please correct and/or let me know.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Nlhicks
  • Solved
One line getting half a line that is blue and the other not getting blue at all
Replies
1
Views
86
Flashbond
F
R
  • Question
Generate dynamic templates with varying mandatory and non-mandatory fields depending on the product type chosen.
Replies
1
Views
364
RajK2005
R
corentint
  • Solved
VBE and Not enough memory
Replies
3
Views
219
corentint
corentint
A
  • Question
Long calculation time on opening of workbook
Replies
3
Views
450
RoryA
RoryA
B
  • Solved
Formula to count unique dates or NOT count based on criteria
Replies
3
Views
1K
bh24524
B

Forum statistics

Threads
1,190,898
Messages
5,983,454
Members
439,843
Latest member
PlanetFitness

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top