VBA for removing extra characters in Barcode scanning

2KGrafix

New Member
Joined
Jan 26, 2024
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
So I created an Excel inventory sheet I would like to scan existing bar codes (part numbers) into. Some codes are QR (data matrix), and some standard industrial bar codes you see on a box of cereal. The issue I'm having is data matrix codes give too much data and standard bar codes either contain spaces or are missing a prefix for some components. For example :

The correct part number is: PCD6MD17E303SBW (All correct part numbers are listed in sheet2 in this format)
Data Matrix Barcode Input: PD6MD 17E30 3SBW S17867999 R7/27/1999 22:30:45 (Missing the C in the prefix which is necessary and contains spaces and extra unwanted data)
Standard Barcode Input: D6MD 17E30 3SBW (Part missing PC prefix altogether and contains spaces)

I have an HTML coding background but not great at writing VBA macros from scratch. I welcome any assistance in finding the right solution.
 
Okay, last request. So I ran the variation of patterns again a specific program's parts. So the very first code you wrote (with 3 pattern types) works best for the following parts. Only the parts that have N/A next to them did not meet the pattern rules. Would you be willing to look at just those N/A parts and see if you could code an additional rule/pattern for those, if at all possible?

FIRST CODEBARCODE PATTERN READOUT (ONLY N/A) ERRORACTUAL PART NUMBER
L1MA-19A286-ACPCL1MA19A286AC
L1MH-19F667-ABPCL1MH19F667AB
PL1M3 9C675 ACT9940173051168_1E_04PCL1M39C675AC
LC5B-13E015-CNPCLC5B13E015CN
P1MT-14A303-BAUBPCP1MT14A303BAUB
RC5B13E014AEN/APCRC5B13E014AE
RB5B13W030CG RH SAE HIGH U625(2) 12/05/23 16:36:55N/A
PM1M3 9E635 BAT1940223191256PCM1M39E635BA
PL1M3 9C675 ACT9940113051210_1E_04PCL1M39C675AC
L1M38005AF2734N/APCL1M38005AF
L1M36K775BFKW03100540180141N/APCL1M36K775BF
P1M38C607GAN/APCP1M38C607GA
LC5B-13E014-ARPCLC5B13E014AR
M1M3-8W005-AAA C757LPCM1M38W005AAA
L1M3-8B274-BAH,EE0WA,24023,13:17:30PCL1M38B274BAH
MB5B13W029BF240125163613N/APCMB5B13W029BF

The second code you wrote with patterns 10-90 worked best for the parts below except the N/A parts. Can you see if there's a rule/pattern that would convert the parts that read out N/A?

SECOND CODE
BARCODE PATTERN READOUT (ONLY N/A) ERROR
ACTUAL PART NUMBER
PPCRC5B17K945AA59B8 038172497N/APCRC5B17K945AA59B8
PPCRB5B17F771BA5UAWPCRB5B17F771BA5UAW
PPCRB5B17F771BAFLADPCRB5B17F771BAFLAD
MLDRB5B17F775AB, 11:12:37 4/18/2023, SEQ 25MLDRB5B17F775AB
PPCRB5B17C831AB51MDPCRB5B17C831AB51MD
PPCLB5B17F001AG53CCPCLB5B17F001AG53CC
PPCRC5B17C831BC5KWHPCRC5B17C831BC5KWH
RB5B-8200-DBSMA4|0001|P3340|YYYYMMDDHHMMSS|PCRB5B8200DBSMA4
CRC5B8200CBSMAS111623 ~233205437242~FD834.1A00.CA11N/APCRC5B8200CBSMAS
PPCLB5B17F001AG5LVLPCLB5B17F001AG5LVL
LB5B-15A255-AEPCLB5B15A255AE
MLDLB5B17F954DF5YZ9, 12:54:56 2/ 1/2024, SEQ 268MLDLB5B17F954DF5YZ9
PPCLB5B17F001AG51MDPCLB5B17F001AG51MD
PPCLC5B17F001AH5KCVPCLC5B17F001AH5KCV
MLDLC5B17F954AB5YBT, 14: 4:13 1/27/2024, SEQ 72MLDLC5B17F954AB5YBT
PPCMB5B17A895AD5KBXPCMB5B17A895AD5KBX
P1MT 14N139 BABBPCP1MT14N139BABB
LC5B-15A425-BDPCLC5B15A425BD
LB5B-8200-FD5YZ9PCLB5B8200FD5YZ9
MLDLB5B17F775BE5YZ9, 1:20:15 1/31/2024, SEQ 59MLDLB5B17F775BE5YZ9
LC5B-15A255- ADN/APCLC5B15A255AD

If it works, great. I can stop pestering you, LOL. Thank you again, my friend.
 
Last edited:
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I missed one for the FIRST SET of parts:

ScanPattern outputActual
RB5B13W029CG RH SAE HIGH U625(2) 12/05/23 16:36:55PC29CGRHSAPCRB5B13W029CG
 
Upvote 0
Hi @2KGrafix

This is the closest I can get:

1706927481942.png


As you can see row 11, 12 and 17 were not matched.
That's because I couldn't find any possible pattern for them to work since they don't follow any strict rule.

11: L1M38005AF2734
12: L1M36K775BFKW03100540180141
17: MB5B13W029BF240125163613

Do you see anything those numbers have all in common? Or anything that would distinguish any of these numbers from others?
The only thing I can think of is following rule for 11 and 17:
<anything><letters only><digits only> and then keep everything but the digits at the end.
Would that help?

Here is my updated code:
VBA Code:
Public Function barcode(text As String) As String
   Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
   Dim temp As String
   Dim pattern10 As String: pattern10 = "(MLD[A-Z0-9]+),.*"
   Dim pattern20 As String: pattern20 = "(PC[A-Z0-9]+)\|.*"
   Dim pattern30 As String: pattern30 = "^([A-Z0-9]{12}) .*"
   Dim pattern40 As String: pattern40 = "^([A-Z0-9]{10,12})$"
   Dim pattern44 As String: pattern44 = "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$"
   Dim pattern45 As String: pattern45 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)"
   Dim pattern50 As String: pattern50 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)"
   Dim pattern60 As String: pattern60 = "([A-Z0-9]{4})-([A-Z0-9]+)-([A-Z0-9]+)"
   Dim pattern70 As String: pattern70 = "^(PC[A-Z0-9]+)$"
   Dim pattern80 As String: pattern80 = "^(PC[A-Z0-9]+) [A-Z0-9]+"
   Dim pattern90 As String: pattern90 = "^P(PC[A-Z0-9]+)$"
   
   Dim pattern100 As String: pattern100 = "([A-Z0-9]{4})-([A-Z0-9]+)- ([A-Z0-9]+)"
   Dim pattern110 As String: pattern110 = "^P(PC[A-Z0-9]+) [A-Z0-9]+$"
   Dim pattern120 As String: pattern120 = "^C([A-Z0-9]+) ~[0-9]+~.*$"
   
   Select Case True
      Case RegExpTest(text, pattern10)
         text = RegExpReplace(text, pattern10, "$1")
         barcode = text
      Case RegExpTest(text, pattern20)
         text = RegExpReplace(text, pattern20, "$1")
         barcode = text
      Case RegExpTest(text, pattern30)
         text = RegExpGet(text, pattern30)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern40)
         text = RegExpGet(text, pattern40)
         barcode = "PC" & text
      Case RegExpTest(text, pattern44)
         text = RegExpGet(text, pattern44)
         text = RegExpReplace(text, "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern45)
         text = RegExpGet(text, pattern45)
         text = RegExpReplace(text, "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern50)
         text = RegExpGet(text, pattern50)
         text = RegExpReplace(text, "([A-Z0-9]+) ([A-Z0-9]+) ([A-Z0-9]+)", "$1$2$3")
         barcode = "50_PC" & text
      Case RegExpTest(text, pattern60)
         text = RegExpGet(text, pattern60)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)-([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern70)
         barcode = RegExpReplace(text, pattern70, "$1")
      Case RegExpTest(text, pattern80)
         text = RegExpGet(text, pattern80)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = text
      Case RegExpTest(text, pattern90)
         text = RegExpGet(text, pattern90)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+)$", "$1")
         barcode = text
      Case RegExpTest(text, pattern100)
         text = RegExpGet(text, pattern100)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)- ([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern110)
         text = RegExpGet(text, pattern110)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+) [A-Z0-9]+$", "$1")
         barcode = text
      Case RegExpTest(text, pattern120)
         text = RegExpGet(text, pattern120)
         text = RegExpReplace(text, "^C([A-Z0-9]+[^0-9])[0-9]* ~[0-9]+~.*$", "$1")
         barcode = "PC" & text
      Case Else
         barcode = "N/A"
   End Select
End Function
Private Function RegExpTest(txt As String, pat As String) As Boolean
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   If rex.test(txt) = True Then
      RegExpTest = True
   Else
      RegExpTest = False
   End If
End Function
Private Function RegExpReplace(txt As String, pat As String, rep As String) As String
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = True
   RegExpReplace = rex.Replace(txt, rep)
End Function
Private Function RegExpGet(txt As String, pat As String)
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = False
   RegExpGet = rex.Execute(txt)(0)
End Function


Please keep me updated.
 
Upvote 1
Update:

1706929253467.png


The code:

VBA Code:
Public Function barcode(text As String) As String
   Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
   Dim temp As String
   Dim pattern10 As String: pattern10 = "(MLD[A-Z0-9]+),.*"
   Dim pattern20 As String: pattern20 = "(PC[A-Z0-9]+)\|.*"
   Dim pattern30 As String: pattern30 = "^([A-Z0-9]{12}) .*"
   Dim pattern40 As String: pattern40 = "^([A-Z0-9]{10,12})$"
   Dim pattern44 As String: pattern44 = "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$"
   Dim pattern45 As String: pattern45 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)"
   Dim pattern50 As String: pattern50 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)"
   Dim pattern60 As String: pattern60 = "([A-Z0-9]{4})-([A-Z0-9]+)-([A-Z0-9]+)"
   Dim pattern70 As String: pattern70 = "^(PC[A-Z0-9]+)$"
   Dim pattern80 As String: pattern80 = "^(PC[A-Z0-9]+) [A-Z0-9]+"
   Dim pattern90 As String: pattern90 = "^P(PC[A-Z0-9]+)$"
   
   Dim pattern100 As String: pattern100 = "([A-Z0-9]{4})-([A-Z0-9]+)- ([A-Z0-9]+)"
   Dim pattern110 As String: pattern110 = "^P(PC[A-Z0-9]+) [A-Z0-9]+$"
   Dim pattern120 As String: pattern120 = "^C([A-Z0-9]+) ~[0-9]+~.*$"
   Dim pattern130 As String: pattern130 = "^([A-Z0-9]+?[A-Z]+)[0-9]+$"
   Dim pattern140 As String: pattern140 = "^([A-Z0-9]+?[A-Z]{2})[A-Z]+[0-9]+$"
   
   Select Case True
      Case RegExpTest(text, pattern10)
         text = RegExpReplace(text, pattern10, "$1")
         barcode = text
      Case RegExpTest(text, pattern20)
         text = RegExpReplace(text, pattern20, "$1")
         barcode = text
      Case RegExpTest(text, pattern30)
         text = RegExpGet(text, pattern30)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern40)
         text = RegExpGet(text, pattern40)
         barcode = "PC" & text
      Case RegExpTest(text, pattern44)
         text = RegExpGet(text, pattern44)
         text = RegExpReplace(text, "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern45)
         text = RegExpGet(text, pattern45)
         text = RegExpReplace(text, "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern50)
         text = RegExpGet(text, pattern50)
         text = RegExpReplace(text, "([A-Z0-9]+) ([A-Z0-9]+) ([A-Z0-9]+)", "$1$2$3")
         barcode = "50_PC" & text
      Case RegExpTest(text, pattern60)
         text = RegExpGet(text, pattern60)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)-([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern70)
         barcode = RegExpReplace(text, pattern70, "$1")
      Case RegExpTest(text, pattern80)
         text = RegExpGet(text, pattern80)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = text
      Case RegExpTest(text, pattern90)
         text = RegExpGet(text, pattern90)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+)$", "$1")
         barcode = text
      Case RegExpTest(text, pattern100)
         text = RegExpGet(text, pattern100)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)- ([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern110)
         text = RegExpGet(text, pattern110)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+) [A-Z0-9]+$", "$1")
         barcode = text
      Case RegExpTest(text, pattern120)
         text = RegExpGet(text, pattern120)
         text = RegExpReplace(text, "^C([A-Z0-9]+[^0-9])[0-9]* ~[0-9]+~.*$", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern130)
         text = RegExpGet(text, pattern130)
         text = RegExpReplace(text, "^([A-Z0-9]+?[A-Z]{2})[A-Z]+[0-9]+$", "$1")
         barcode = "PC" & text
      Case Else
         barcode = "N/A"
   End Select
End Function
Private Function RegExpTest(txt As String, pat As String) As Boolean
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   If rex.test(txt) = True Then
      RegExpTest = True
   Else
      RegExpTest = False
   End If
End Function
Private Function RegExpReplace(txt As String, pat As String, rep As String) As String
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = True
   RegExpReplace = rex.Replace(txt, rep)
End Function
Private Function RegExpGet(txt As String, pat As String)
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = False
   RegExpGet = rex.Execute(txt)(0)
End Function
 
Last edited:
Upvote 1
Update V2:

VBA Code:
Public Function barcode(text As String) As String
   Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
   Dim temp As String
   Dim pattern10 As String: pattern10 = "(MLD[A-Z0-9]+),.*"
   Dim pattern20 As String: pattern20 = "(PC[A-Z0-9]+)\|.*"
   Dim pattern30 As String: pattern30 = "^([A-Z0-9]{12}) .*"
   Dim pattern40 As String: pattern40 = "^([A-Z0-9]{10,12})$"
   Dim pattern44 As String: pattern44 = "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$"
   Dim pattern45 As String: pattern45 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)"
   Dim pattern50 As String: pattern50 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)"
   Dim pattern60 As String: pattern60 = "([A-Z0-9]{4})-([A-Z0-9]+)-([A-Z0-9]+)"
   Dim pattern70 As String: pattern70 = "^(PC[A-Z0-9]+)$"
   Dim pattern80 As String: pattern80 = "^(PC[A-Z0-9]+) [A-Z0-9]+"
   Dim pattern90 As String: pattern90 = "^P(PC[A-Z0-9]+)$"
   
   Dim pattern100 As String: pattern100 = "([A-Z0-9]{4})-([A-Z0-9]+)- ([A-Z0-9]+)"
   Dim pattern110 As String: pattern110 = "^P(PC[A-Z0-9]+) [A-Z0-9]+$"
   Dim pattern120 As String: pattern120 = "^C([A-Z0-9]+) ~[0-9]+~.*$"
   Dim pattern130 As String: pattern130 = "^([A-Z0-9]+?[A-Z]{2}?)[A-Z0-9]+$"
   Dim pattern140 As String: pattern140 = "^([A-Z0-9]+?[A-Z]+)[0-9]+$"
   
   Select Case True
      Case RegExpTest(text, pattern10)
         text = RegExpReplace(text, pattern10, "$1")
         barcode = text
      Case RegExpTest(text, pattern20)
         text = RegExpReplace(text, pattern20, "$1")
         barcode = text
      Case RegExpTest(text, pattern30)
         text = RegExpGet(text, pattern30)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern40)
         text = RegExpGet(text, pattern40)
         barcode = "PC" & text
      Case RegExpTest(text, pattern44)
         text = RegExpGet(text, pattern44)
         text = RegExpReplace(text, "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern45)
         text = RegExpGet(text, pattern45)
         text = RegExpReplace(text, "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern50)
         text = RegExpGet(text, pattern50)
         text = RegExpReplace(text, "([A-Z0-9]+) ([A-Z0-9]+) ([A-Z0-9]+)", "$1$2$3")
         barcode = "50_PC" & text
      Case RegExpTest(text, pattern60)
         text = RegExpGet(text, pattern60)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)-([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern70)
         barcode = RegExpReplace(text, pattern70, "$1")
      Case RegExpTest(text, pattern80)
         text = RegExpGet(text, pattern80)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = text
      Case RegExpTest(text, pattern90)
         text = RegExpGet(text, pattern90)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+)$", "$1")
         barcode = text
      Case RegExpTest(text, pattern100)
         text = RegExpGet(text, pattern100)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)- ([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern110)
         text = RegExpGet(text, pattern110)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+) [A-Z0-9]+$", "$1")
         barcode = text
      Case RegExpTest(text, pattern120)
         text = RegExpGet(text, pattern120)
         text = RegExpReplace(text, "^C([A-Z0-9]+[^0-9])[0-9]* ~[0-9]+~.*$", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern130)
         text = RegExpGet(text, pattern130)
         text = RegExpReplace(text, "^([A-Z0-9]+?[A-Z]{2}?)[A-Z0-9]+$", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern140)
         text = RegExpGet(text, pattern140)
         text = RegExpReplace(text, "^([A-Z0-9]+?[A-Z]+)[0-9]+$", "$1")
         barcode = "PC" & text
      Case Else
         barcode = "N/A"
   End Select
End Function
Private Function RegExpTest(txt As String, pat As String) As Boolean
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   If rex.test(txt) = True Then
      RegExpTest = True
   Else
      RegExpTest = False
   End If
End Function
Private Function RegExpReplace(txt As String, pat As String, rep As String) As String
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = True
   RegExpReplace = rex.Replace(txt, rep)
End Function
Private Function RegExpGet(txt As String, pat As String)
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = False
   RegExpGet = rex.Execute(txt)(0)
End Function
 
Upvote 1
Solution
WOW! This is great. I can't thank you enough for all the time and effort you put into this. Working with my elementary understanding of VBA. You rock, Sir.
 
Upvote 0
You're welcome, glad I could help.

Please correct one thing in the code:

VBA Code:
Case RegExpTest(text, pattern50)
         text = RegExpGet(text, pattern50)
         text = RegExpReplace(text, "([A-Z0-9]+) ([A-Z0-9]+) ([A-Z0-9]+)", "$1$2$3")
         barcode = "50_PC" & text

VBA Code:
barcode = "50_PC" & text
should be
VBA Code:
barcode = "PC" & text

without the "50_" (which I put there for testing purposes)

Please let me know if anything goes wrong.

Best regards
Pete
 
Upvote 0
Hi Pete, so I've been testing the form. It works great. I ran into two issues. When I scan a barcode that reads out MLD part numbers correctly, it returns PCMLD. See the example below. The part number is indeed MLDL1MB105B00BB but the barcode pattern converts it to just PLMLD only, nothing more. Is there an additional pattern that can be written for this to add to the code you previously wrote? Let me know what you think. Thanks.

1MLDL1MB105B00BBPCMLD#N/A#N/A
 
Upvote 0
Hi Pete, so I've been testing the form. It works great. I ran into two issues. When I scan a barcode that reads out MLD part numbers correctly, it returns PCMLD. See the example below. The part number is indeed MLDL1MB105B00BB but the barcode pattern converts it to just PLMLD only, nothing more. Is there an additional pattern that can be written for this to add to the code you previously wrote? Let me know what you think. Thanks.

1MLDL1MB105B00BBPCMLD#N/A#N/A
Hi, sorry about that. I totally forgot the MLD in my patterns :p
There is only a MLD pattern which is followed by a comma

Just insert the following pattern and code:
VBA Code:
Dim pattern00 As String: pattern00 = "(MLD[A-Z0-9]+)"
VBA Code:
Case RegExpTest(text, pattern00)
         text = RegExpReplace(text, pattern00, "$1")
         barcode = text

Here's the complete VBA Code Module:
VBA Code:
Public Function barcode(text As String) As String
   Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
   Dim temp As String
   Dim pattern00 As String: pattern00 = "(MLD[A-Z0-9]+)"
   Dim pattern10 As String: pattern10 = "(MLD[A-Z0-9]+),.*"
   Dim pattern20 As String: pattern20 = "(PC[A-Z0-9]+)\|.*"
   Dim pattern30 As String: pattern30 = "^([A-Z0-9]{12}) .*"
   Dim pattern40 As String: pattern40 = "^([A-Z0-9]{10,12})$"
   Dim pattern44 As String: pattern44 = "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$"
   Dim pattern45 As String: pattern45 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)"
   Dim pattern50 As String: pattern50 = "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)"
   Dim pattern60 As String: pattern60 = "([A-Z0-9]{4})-([A-Z0-9]+)-([A-Z0-9]+)"
   Dim pattern70 As String: pattern70 = "^(PC[A-Z0-9]+)$"
   Dim pattern80 As String: pattern80 = "^(PC[A-Z0-9]+) [A-Z0-9]+"
   Dim pattern90 As String: pattern90 = "^P(PC[A-Z0-9]+)$"
   
   Dim pattern100 As String: pattern100 = "([A-Z0-9]{4})-([A-Z0-9]+)- ([A-Z0-9]+)"
   Dim pattern110 As String: pattern110 = "^P(PC[A-Z0-9]+) [A-Z0-9]+$"
   Dim pattern120 As String: pattern120 = "^C([A-Z0-9]+) ~[0-9]+~.*$"
   Dim pattern130 As String: pattern130 = "^([A-Z0-9]+?[A-Z]{2}?)[A-Z0-9]+$"
   Dim pattern140 As String: pattern140 = "^([A-Z0-9]+?[A-Z]+)[0-9]+$"
   
   Select Case True
      Case RegExpTest(text, pattern00)
         text = RegExpReplace(text, pattern00, "$1")
         barcode = text
      Case RegExpTest(text, pattern10)
         text = RegExpReplace(text, pattern10, "$1")
         barcode = text
      Case RegExpTest(text, pattern20)
         text = RegExpReplace(text, pattern20, "$1")
         barcode = text
      Case RegExpTest(text, pattern30)
         text = RegExpGet(text, pattern30)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern40)
         text = RegExpGet(text, pattern40)
         barcode = "PC" & text
      Case RegExpTest(text, pattern44)
         text = RegExpGet(text, pattern44)
         text = RegExpReplace(text, "^([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9]+)$", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern45)
         text = RegExpGet(text, pattern45)
         text = RegExpReplace(text, "([A-Z0-9]{4}) ([A-Z0-9]+) ([A-Z0-9_]{2}?)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern50)
         text = RegExpGet(text, pattern50)
         text = RegExpReplace(text, "([A-Z0-9]+) ([A-Z0-9]+) ([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern60)
         text = RegExpGet(text, pattern60)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)-([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern70)
         barcode = RegExpReplace(text, pattern70, "$1")
      Case RegExpTest(text, pattern80)
         text = RegExpGet(text, pattern80)
         text = RegExpReplace(text, "([A-Z0-9]+) .*", "$1")
         barcode = text
      Case RegExpTest(text, pattern90)
         text = RegExpGet(text, pattern90)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+)$", "$1")
         barcode = text
      Case RegExpTest(text, pattern100)
         text = RegExpGet(text, pattern100)
         text = RegExpReplace(text, "([A-Z0-9]+)-([A-Z0-9]+)- ([A-Z0-9]+)", "$1$2$3")
         barcode = "PC" & text
      Case RegExpTest(text, pattern110)
         text = RegExpGet(text, pattern110)
         text = RegExpReplace(text, "^P(PC[A-Z0-9]+) [A-Z0-9]+$", "$1")
         barcode = text
      Case RegExpTest(text, pattern120)
         text = RegExpGet(text, pattern120)
         text = RegExpReplace(text, "^C([A-Z0-9]+[^0-9])[0-9]* ~[0-9]+~.*$", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern130)
         text = RegExpGet(text, pattern130)
         text = RegExpReplace(text, "^([A-Z0-9]+?[A-Z]{2}?)[A-Z0-9]+$", "$1")
         barcode = "PC" & text
      Case RegExpTest(text, pattern140)
         text = RegExpGet(text, pattern140)
         text = RegExpReplace(text, "^([A-Z0-9]+?[A-Z]+)[0-9]+$", "$1")
         barcode = "PC" & text
      Case Else
         barcode = "N/A"
   End Select
End Function
Private Function RegExpTest(txt As String, pat As String) As Boolean
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   If rex.test(txt) = True Then
      RegExpTest = True
   Else
      RegExpTest = False
   End If
End Function
Private Function RegExpReplace(txt As String, pat As String, rep As String) As String
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = True
   RegExpReplace = rex.Replace(txt, rep)
End Function
Private Function RegExpGet(txt As String, pat As String)
   Dim rex As Object: Set rex = CreateObject("VBScript.RegExp")
   rex.Pattern = pat
   rex.Global = False
   RegExpGet = rex.Execute(txt)(0)
End Function
 
Upvote 1
Thank you! What I ended up doing was switching patterns 00 and 10, and it worked fine. Thank you again, my friend. If you have a moment, take a look at another issue I posted in the forum about data validation issues when pulling data from another cell, the same form we're working on here, but a different issue. Thank you again.
 
Upvote 0

Forum statistics

Threads
1,224,752
Messages
6,180,742
Members
452,996
Latest member
nelsonsix66

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
Back
Top