# Convert UPC-E to UPC-A? Truncated UPCs

#### unc2plo

##### Board Regular
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.

#### RalphA

##### Well-known Member
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.

#### jindon

##### MrExcel MVP

Can you post few example and required results?

#### jindon

##### MrExcel MVP
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``````

#### jindon

##### MrExcel MVP
Correction
Rich (BB code):
``````    myPtn = .replace(txt, "*\$1")
.Pattern = "^" & Mid\$(myPtn,2) & "\$"``````
should be
Rich (BB code):
``````    myPtn = .replace(txt, "\$1*")
.Pattern = "^" & myPtn & "\$"``````

#### jindon

##### MrExcel MVP
Correction again
Rich (BB code):
``    myPtn = .replace(txt, "\$1*")``
should be
Rich (BB code):
``    myPtn = .replace(txt, "\$1{1,}")``

#### wolftamer

##### New Member
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:

#### dgates12

##### New Member
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

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!

#### MrNedF

##### New Member
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
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

#### Norry

##### New Member
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.

Replies
1
Views
86
Replies
1
Views
364
Replies
3
Views
219
Replies
3
Views
450
Replies
3
Views
1K

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

### 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.

### Which adblocker are you using?

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

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