VBA for removing extra characters in Barcode scanning

2KGrafix · Jan 26, 2024

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.

2KGrafix · Jan 30, 2024

I did get a chance to test the VBA you provided. What I did notice is I do not have "= barcode" as a function. I do have a Code128 barcode font. Not sure if that matters. See screenshot.

2KGrafix · Jan 30, 2024

2KGrafix said:
I did get a chance to test the VBA you provided. What I did notice is I do not have "= barcode" as a function. I do have a Code128 barcode font. Not sure if that matters. See screenshot.

View attachment 105975

Disregard that last message. I pasted your code in the wrong module. It does work.

Anfinsen · Jan 30, 2024

I may be way off on thinking here, but I think trying to account for any variable that could possible exist, through coding, is a bad idea. Whenever a new variable pops up, you would have to change the code to accommodate this "new" scenario.
Let me suggest an alternative method, which up front may require more work, but in the long run, will be simpler to accommodate new scenarios that don't fit previous patterns.
Since you have all the barcodes, and know what they should read as, add a "cross reference" table to your sheet, and reference that when scanning a barcode. then when a new, previously unidentified scenario pops up, you just have to add it to your "cross reference" database.

Book1

A

B

C

1

Correct Part

Data Matrix

Standard Barcode Input

2

PCD6MD17E303SBW

PD6MD 17E30 3SBW S17867999 R7/27/1999 22:30:45

D6MD 17E30 3SBW

3

4

5

6

7

Sheet1

2KGrafix · Jan 31, 2024

Anfinsen said:
I may be way off on thinking here, but I think trying to account for any variable that could possible exist, through coding, is a bad idea. Whenever a new variable pops up, you would have to change the code to accommodate this "new" scenario.
Let me suggest an alternative method, which up front may require more work, but in the long run, will be simpler to accommodate new scenarios that don't fit previous patterns.
Since you have all the barcodes, and know what they should read as, add a "cross reference" table to your sheet, and reference that when scanning a barcode. then when a new, previously unidentified scenario pops up, you just have to add it to your "cross reference" database.

Book1
A B C
1 Correct Part Data Matrix Standard Barcode Input
2 PCD6MD17E303SBW PD6MD 17E30 3SBW S17867999 R7/27/1999 22:30:45 D6MD 17E30 3SBW
3
4
5
6
7
Sheet1

Thank you and I understand what you're getting at but for now, Pete has been great at helping me solve this issue. I'm going to wait for him, but I will keep your suggestion in mind.

PeteWright · Jan 31, 2024

@2KGrafix
I updated my functions an created a table to visualize the results:

barcode_scan.xlsm

A

B

C

D

E

1

MLDLB5B17F775BE5YZ9, 22:57:38 1/26/2024, SEQ 224

MLDLB5B17F775BE5YZ9

TRUE

2

MLDLC5B17F954BE5YBT, 11:52: 2 1/22/2024, SEQ 257

MLDLC5B17F954BE5YBT

TRUE

3

PLB5B 13B414 AB S10155600 D7/6/1998 0:22:1

PCLB5B13B414AB

TRUE

4

PPCLB5B17F771BB5UAW

PCLB5B17F771BB5UAW

TRUE

5

LB5B-8200-EB5UAW

PCLB5B8200EB5UAW

TRUE

6

PCLC5B-15A227-AC

PCLC5B15A227AC

TRUE

7

PLC5B 17A848 AB S10167471 D1/15/2024 8:48:9 12345

PCLC5B17A848AB

TRUE

8

PPCLB5B17C831AE5KBX

PCLC5B17C831AE5KBX

PCLB5B17C831AE5KBX

FALSE

Wrong result! "PCLC" should be "PPCLB"

9

PPCLC5B17C831AE5LPM

PCLC5B17C831AE5LPM

TRUE

10

PCLC5B17E911AASMAS

TRUE

11

PCLC5B17E911CA59B8 10324

PCLC5B17E911CA59B8

TRUE

12

PPCLC5B17F001AH51MD

PCLC5B17F001AH51MD

TRUE

13

PPCLC5B17K945AD59B8

PCLC5B17K945AD59B8

TRUE

14

PCLC5B8200BESMA4|240238352706||20240123181548

PCLC5B8200BESMA4

TRUE

15

LC5B-8200-DE5KW9

PCLC5B8200DE5KW9

TRUE

16

L1MT-13A803-AB

PCL1MT13A803AB

TRUE

17

L1M3-8B273-BAF,EE0WA,24010,18:10:12

PCL1M38B273BAF

TRUE

18

L1M38005BF7482

PCL1M38005BF

N/A

FALSE

no pattern possible: extra "7482" at the end

19

PPCMB5J17F771AA51MD

PCMB5J17F771AA51MD

TRUE

20

M1M3-8W005-AAA C757L

PCM1M38W005AAA

TRUE

21

P1MT-15K867-BBA

PCP1MT15K867BBA

TRUE

22

P1M38C607FA

PCP1M38C607FA

TRUE

23

P1MT 14N139 BADB

PCP1MT14N139BADB

TRUE

24

MB5B13W030JG240125045754

PCMB5B13W030JG

N/A

FALSE

current patterns don't match the extra length "240125045754" at the end

25

P1MT-14A303-BBCA

PCP1MT14A303BBCA

TRUE

26

RB5B-8200-DBSMA4|0001|P3340|YYYYMMDDHHMMSS|

PCRB5B8200DBSMA4

TRUE

27

CRC5B8200CBSMAS111623 ~233205437218~FD834.1A00.CA11

PCRC5B8200CBSMAS

N/A

FALSE

no pattern possible: 1) extra "C" at the beginning; 2) extra "111623" at the end

28

RB5B13W020CG RH SAE HIGH U625(2) 12/05/23 16:36:55

PCRB5B13W029CG

PCRB5B13W020CG

FALSE

Wrong result! number "29" instead of "20"

29

PPCRC5B17C831BC53CC

PCRC5B17C831BB53CC

PCRC5B17C831BC53CC

FALSE

Wrong result! "BB53" should be "BC53" at the end

30

RC5B13E014AE

PCRC5B13E014AE

TRUE

31

PPCRB5B17F765BA5JP4

PCRB5B17F765BA5JP4

TRUE

32

33

total right guesses

25

34

right guess rate

81%

Sheet2

Cell Formulas
Range	Formula
C1:C31	C1	= barcode(A1)
D1:D31	D1	=C1=B1
D33	D33	= COUNTIF(D1:D31,TRUE)
D34	D34	= D33/COUNTA(D1:D31)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D1:D31	Cell Value	=FALSE	text	NO
D1:D31	Cell Value	=TRUE	text	NO
A1:C31	Expression	=$D1=FALSE	text	NO

Here's the VBA code you should just paste into a (new) module:

VBA Code:

Option Explicit

Private 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 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]+)$"
  
   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, 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 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

As you can see I got a 81% success rate

I suggest you test my function with your whole data and check what "success rate" you get.

Then please let me know how we should proceed or how my function should be modified.

PeteWright · Jan 31, 2024

PeteWright said:
@2KGrafix
I updated my functions an created a table to visualize the results:

barcode_scan.xlsm
A B C D E
1 MLDLB5B17F775BE5YZ9, 22:57:38 1/26/2024, SEQ 224 MLDLB5B17F775BE5YZ9 MLDLB5B17F775BE5YZ9 TRUE
2 MLDLC5B17F954BE5YBT, 11:52: 2 1/22/2024, SEQ 257 MLDLC5B17F954BE5YBT MLDLC5B17F954BE5YBT TRUE
3 PLB5B 13B414 AB S10155600 D7/6/1998 0:22:1 PCLB5B13B414AB PCLB5B13B414AB TRUE
4 PPCLB5B17F771BB5UAW PCLB5B17F771BB5UAW PCLB5B17F771BB5UAW TRUE
5 LB5B-8200-EB5UAW PCLB5B8200EB5UAW PCLB5B8200EB5UAW TRUE
6 PCLC5B-15A227-AC PCLC5B15A227AC PCLC5B15A227AC TRUE
7 PLC5B 17A848 AB S10167471 D1/15/2024 8:48:9 12345 PCLC5B17A848AB PCLC5B17A848AB TRUE
8 PPCLB5B17C831AE5KBX PCLC5B17C831AE5KBX PCLB5B17C831AE5KBX FALSE Wrong result! "PCLC" should be "PPCLB"
9 PPCLC5B17C831AE5LPM PCLC5B17C831AE5LPM PCLC5B17C831AE5LPM TRUE
10 PCLC5B17E911AASMAS PCLC5B17E911AASMAS PCLC5B17E911AASMAS TRUE
11 PCLC5B17E911CA59B8 10324 PCLC5B17E911CA59B8 PCLC5B17E911CA59B8 TRUE
12 PPCLC5B17F001AH51MD PCLC5B17F001AH51MD PCLC5B17F001AH51MD TRUE
13 PPCLC5B17K945AD59B8 PCLC5B17K945AD59B8 PCLC5B17K945AD59B8 TRUE
14 PCLC5B8200BESMA4|240238352706||20240123181548 PCLC5B8200BESMA4 PCLC5B8200BESMA4 TRUE
15 LC5B-8200-DE5KW9 PCLC5B8200DE5KW9 PCLC5B8200DE5KW9 TRUE
16 L1MT-13A803-AB PCL1MT13A803AB PCL1MT13A803AB TRUE
17 L1M3-8B273-BAF,EE0WA,24010,18:10:12 PCL1M38B273BAF PCL1M38B273BAF TRUE
18 L1M38005BF7482 PCL1M38005BF N/A FALSE no pattern possible: extra "7482" at the end
19 PPCMB5J17F771AA51MD PCMB5J17F771AA51MD PCMB5J17F771AA51MD TRUE
20 M1M3-8W005-AAA C757L PCM1M38W005AAA PCM1M38W005AAA TRUE
21 P1MT-15K867-BBA PCP1MT15K867BBA PCP1MT15K867BBA TRUE
22 P1M38C607FA PCP1M38C607FA PCP1M38C607FA TRUE
23 P1MT 14N139 BADB PCP1MT14N139BADB PCP1MT14N139BADB TRUE
24 MB5B13W030JG240125045754 PCMB5B13W030JG N/A FALSE current patterns don't match the extra length "240125045754" at the end
25 P1MT-14A303-BBCA PCP1MT14A303BBCA PCP1MT14A303BBCA TRUE
26 RB5B-8200-DBSMA4|0001|P3340|YYYYMMDDHHMMSS| PCRB5B8200DBSMA4 PCRB5B8200DBSMA4 TRUE
27 CRC5B8200CBSMAS111623 ~233205437218~FD834.1A00.CA11 PCRC5B8200CBSMAS N/A FALSE no pattern possible: 1) extra "C" at the beginning; 2) extra "111623" at the end
28 RB5B13W020CG RH SAE HIGH U625(2) 12/05/23 16:36:55 PCRB5B13W029CG PCRB5B13W020CG FALSE Wrong result! number "29" instead of "20"
29 PPCRC5B17C831BC53CC PCRC5B17C831BB53CC PCRC5B17C831BC53CC FALSE Wrong result! "BB53" should be "BC53" at the end
30 RC5B13E014AE PCRC5B13E014AE PCRC5B13E014AE TRUE
31 PPCRB5B17F765BA5JP4 PCRB5B17F765BA5JP4 PCRB5B17F765BA5JP4 TRUE
32
33 total right guesses 25
34 right guess rate 81%
Sheet2
Cell Formulas
Range Formula
C1:C31 C1 = barcode(A1)
D1:D31 D1 =C1=B1
D33 D33 = COUNTIF(D1:D31,TRUE)
D34 D34 = D33/COUNTA(D1:D31)
Cells with Conditional Formatting
Cell Condition Cell Format Stop If True
D1:D31 Cell Value =FALSE text NO
D1:D31 Cell Value =TRUE text NO
A1:C31 Expression =$D1=FALSE text NO

Here's the VBA code you should just paste into a (new) module:

VBA Code:

Option Explicit Private 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 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]+)$" 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, 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 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

As you can see I got a 81% success rate

I suggest you test my function with your whole data and check what "success rate" you get.

Then please let me know how we should proceed or how my function should be modified.

@2KGrafix
I just found a mistake:

VBA Code:

Private Function barcode(text As String) As String

Private Function should be Public Function otherwise it will not work in a worksheet.

VBA Code:

Public Function barcode(text As String) As String

2KGrafix · Jan 31, 2024

PeteWright said:
@2KGrafix
I updated my functions an created a table to visualize the results:

barcode_scan.xlsm
A B C D E
1 MLDLB5B17F775BE5YZ9, 22:57:38 1/26/2024, SEQ 224 MLDLB5B17F775BE5YZ9 MLDLB5B17F775BE5YZ9 TRUE
2 MLDLC5B17F954BE5YBT, 11:52: 2 1/22/2024, SEQ 257 MLDLC5B17F954BE5YBT MLDLC5B17F954BE5YBT TRUE
3 PLB5B 13B414 AB S10155600 D7/6/1998 0:22:1 PCLB5B13B414AB PCLB5B13B414AB TRUE
4 PPCLB5B17F771BB5UAW PCLB5B17F771BB5UAW PCLB5B17F771BB5UAW TRUE
5 LB5B-8200-EB5UAW PCLB5B8200EB5UAW PCLB5B8200EB5UAW TRUE
6 PCLC5B-15A227-AC PCLC5B15A227AC PCLC5B15A227AC TRUE
7 PLC5B 17A848 AB S10167471 D1/15/2024 8:48:9 12345 PCLC5B17A848AB PCLC5B17A848AB TRUE
8 PPCLB5B17C831AE5KBX PCLC5B17C831AE5KBX PCLB5B17C831AE5KBX FALSE Wrong result! "PCLC" should be "PPCLB"
9 PPCLC5B17C831AE5LPM PCLC5B17C831AE5LPM PCLC5B17C831AE5LPM TRUE
10 PCLC5B17E911AASMAS PCLC5B17E911AASMAS PCLC5B17E911AASMAS TRUE
11 PCLC5B17E911CA59B8 10324 PCLC5B17E911CA59B8 PCLC5B17E911CA59B8 TRUE
12 PPCLC5B17F001AH51MD PCLC5B17F001AH51MD PCLC5B17F001AH51MD TRUE
13 PPCLC5B17K945AD59B8 PCLC5B17K945AD59B8 PCLC5B17K945AD59B8 TRUE
14 PCLC5B8200BESMA4|240238352706||20240123181548 PCLC5B8200BESMA4 PCLC5B8200BESMA4 TRUE
15 LC5B-8200-DE5KW9 PCLC5B8200DE5KW9 PCLC5B8200DE5KW9 TRUE
16 L1MT-13A803-AB PCL1MT13A803AB PCL1MT13A803AB TRUE
17 L1M3-8B273-BAF,EE0WA,24010,18:10:12 PCL1M38B273BAF PCL1M38B273BAF TRUE
18 L1M38005BF7482 PCL1M38005BF N/A FALSE no pattern possible: extra "7482" at the end
19 PPCMB5J17F771AA51MD PCMB5J17F771AA51MD PCMB5J17F771AA51MD TRUE
20 M1M3-8W005-AAA C757L PCM1M38W005AAA PCM1M38W005AAA TRUE
21 P1MT-15K867-BBA PCP1MT15K867BBA PCP1MT15K867BBA TRUE
22 P1M38C607FA PCP1M38C607FA PCP1M38C607FA TRUE
23 P1MT 14N139 BADB PCP1MT14N139BADB PCP1MT14N139BADB TRUE
24 MB5B13W030JG240125045754 PCMB5B13W030JG N/A FALSE current patterns don't match the extra length "240125045754" at the end
25 P1MT-14A303-BBCA PCP1MT14A303BBCA PCP1MT14A303BBCA TRUE
26 RB5B-8200-DBSMA4|0001|P3340|YYYYMMDDHHMMSS| PCRB5B8200DBSMA4 PCRB5B8200DBSMA4 TRUE
27 CRC5B8200CBSMAS111623 ~233205437218~FD834.1A00.CA11 PCRC5B8200CBSMAS N/A FALSE no pattern possible: 1) extra "C" at the beginning; 2) extra "111623" at the end
28 RB5B13W020CG RH SAE HIGH U625(2) 12/05/23 16:36:55 PCRB5B13W029CG PCRB5B13W020CG FALSE Wrong result! number "29" instead of "20"
29 PPCRC5B17C831BC53CC PCRC5B17C831BB53CC PCRC5B17C831BC53CC FALSE Wrong result! "BB53" should be "BC53" at the end
30 RC5B13E014AE PCRC5B13E014AE PCRC5B13E014AE TRUE
31 PPCRB5B17F765BA5JP4 PCRB5B17F765BA5JP4 PCRB5B17F765BA5JP4 TRUE
32
33 total right guesses 25
34 right guess rate 81%
Sheet2
Cell Formulas
Range Formula
C1:C31 C1 = barcode(A1)
D1:D31 D1 =C1=B1
D33 D33 = COUNTIF(D1:D31,TRUE)
D34 D34 = D33/COUNTA(D1:D31)
Cells with Conditional Formatting
Cell Condition Cell Format Stop If True
D1:D31 Cell Value =FALSE text NO
D1:D31 Cell Value =TRUE text NO
A1:C31 Expression =$D1=FALSE text NO

Here's the VBA code you should just paste into a (new) module:

VBA Code:

Option Explicit Private 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 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]+)$" 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, 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 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

As you can see I got a 81% success rate

I suggest you test my function with your whole data and check what "success rate" you get.

Then please let me know how we should proceed or how my function should be modified.

This is great. I only have one request. Could you combine this set of patterns and code with the first one you sent me? I noticed one of the barcodes in the first version that worked no longer worked in the last version of code.

PeteWright · Feb 1, 2024

2KGrafix said:
This is great. I only have one request. Could you combine this set of patterns and code with the first one you sent me? I noticed one of the barcodes in the first version that worked no longer worked in the last version of code.

You are right, some codes are not working anymore that's because I changed the order in which checks are performed.

VBA Code:

   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 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]+)$"

What you see is a sequence of checks against the text string to find a match.
(I made steps of 10 in numbering to make it easier to insert new patterns without the need to renumber everything).
The first pattern that results in a match will be taken as right, disregarding all following patterns. So order is very important here.
I wrote a very simple and "stupid" function which does not take into account that another match would fit better.

But maybe together we can figure something out that is a little bit smarter.
For that purpose I need your input.

First, is my attempt good enough to work with? Or would you suggest something different than that?
Remember, code is stupid, it follows rules. Can you find some rules that work better than mine?

Please let me know what you think.

Best regards

2KGrafix · Feb 1, 2024

PeteWright said:
You are right, some codes are not working anymore that's because I changed the order in which checks are performed.

VBA Code:

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 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]+)$"

What you see is a sequence of checks against the text string to find a match.
(I made steps of 10 in numbering to make it easier to insert new patterns without the need to renumber everything).
The first pattern that results in a match will be taken as right, disregarding all following patterns. So order is very important here.
I wrote a very simple and "stupid" function which does not take into account that another match would fit better.

But maybe together we can figure something out that is a little bit smarter.
For that purpose I need your input.

First, is my attempt good enough to work with? Or would you suggest something different than that?
Remember, code is stupid, it follows rules. Can you find some rules that work better than mine?

Please let me know what you think.

Best regards

Let me play around with the order. There may be some components that we won't need to scan at all, eliminating some patterns in favor of others.

PeteWright · Feb 1, 2024

2KGrafix said:
Let me play around with the order. There may be some components that we won't need to scan at all, eliminating some patterns in favor of others.

Okay.
Do you need any assistance?

Let me explain Regular Expressions a little...

Capturing:
[A-Z0-9] will find any capital letter or digit
. will find any character
^ will find the beginning of a string
$ will find the end of a string

Repetition:
* will find zero or more occurrences of previous item
+ will find one or more occurrences of previous item
? will find zero or one occurrences of previous item
{n} will find exactly n occurrences of previous item
{a,b} will find at least a but not more than b occurrences of previous item

Grouping:
(...) will group the items between brackets into one capturing group
$n return the items of the n-th capturing group

Special characters:
Special characters are part of the Regular Expression Syntax and can not be entered for searching.
Instead they should be "escaped" by the "escape character" which is a backslash "\"
\| will match a |
\$ will match $ (dollar)
\. will match . (period)
and so on...

Maybe this helps you a little

VBA for removing extra characters in Barcode scanning

2KGrafix

New Member

2KGrafix

New Member

Excel Facts

2KGrafix

New Member

Anfinsen

Board Regular

2KGrafix

New Member

PeteWright

Active Member

PeteWright

Active Member

2KGrafix

New Member

PeteWright

Active Member

2KGrafix

New Member

PeteWright

Active Member

Similar threads

Forum statistics

Share this page

VBA for removing extra characters in Barcode scanning

New Member

New Member

Excel Facts

New Member

Board Regular

New Member

Active Member

Active Member

New Member

Active Member

New Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock