VBA - Split the data

[Mallesh23]

Hi Team,

Column A is a Consolidated Invoices of different Country's Company. different style of drafting.

Now task is extract Invoices separately. Expected Output is in Column B.

I am Unable to split the data as Column A data is not a standard one.

Looking for a Macro. Thanks.

Sample dummy data

Book1
	A	B
1	Invoice	Expected Invoice
2	5300000798-PIF-PR	5300000798
3	7350001120 RW BAL	7350001120
4	5100000182-Bal-20	5100000182
5	D-PR-10967-315000492	315000492
6	F-W-10713-3150004797
7	2333-RW-4400000176-P	4400000176
8	6200110592	6200110592
9	7800000292-8451-P	7800000292
10	635011186 - 10 - p	635011186
11	D-ED-10566-315000470	315000470
12	F-W-10488-3150004700	3150004700
13	5650000669/W&D/DEP	5650000669
14	5650000671/W&D/DEP	5650000671
15	5650000606 fnl pmt S	5650000606
16	5750000669-bal-35	5750000669
17	refu25188/6000000502	6000000502
18	9161/4750000388/vs/p	4750000388
19	F-ED-9861-3150004404	3150004404
20	6550000757fp10	6550000757
21	9202/4750000419/VS/P	4750000419
22	7250000387RWDEP	7250000387
23	9619/4750000712/RW/C	4750000712
24	F-W-10455-3150004682	3150004682
25	D-W-11009-3150004941	3150004941
26	61001540222366-10-P	6.10015E+13
27	6200000780	6200000780
28	F-RW-10212-0004571
29	P25132/6000000466 RW	6000000466
30	2365-ED-4400000196-D	4400000196
31	24903 RW/PP (ML)
32	6550000363dp10	6550000363
33	5492693164965788	5492693164965788
34	6350000532 - 10 - D	6350000532
35	6550000882dp30	6550000882
36	D/P/5050000791-16762	5050000791
37	f-sr-3150003955-8853	3150003955
38	6150000163/Refunded Dep/Cancelled Contract/10	6150000163
39	AX41500003618	41500003618
40	4150000330 - D
41	24318 PR/PO
42	4300001631 - 10 - P	4300001631
43	DP-PR-#2394-281
Sheet1

Thanks
mg

 

[Peter_SSs]

Could there really be blank cells in the column D criteria list or did that only happen because you decided later to insert a blank row in your sample data?

What about that question?

if future change in Criteria list it should accomodate

Can you spell that out in more detail?

Criteria will be Inner loop

What do you mean by that?

 

[Mallesh23]

Hi Peter,
a) Could there really be blank cells in the column D criteria list or did that only happen because you decided later to insert a blank row in your sample data?

No Blank in Criteria.

b )if future change in Criteria list it should accomodate

Criteria Account Code

7350 :=> Ignore 7350 Keep 735

600

165

3) Criteria will be Inner loop

Means My Criteria and Invoice will not be be same row.

LR_Invoices = Range("A"&rows.count).end(xlup).row
Criteria_LastRow = Range("A"&rows.count).end(xlup).row

for i = 2 to LR_Invoices
for j = 2 to Criteria_LastRow
if cells(i,j) = account code
cells(i,2).value = account no ' Update Column 2
exit j
end if
next j
next i

 

[Peter_SSs]

Sorry, more questions I'm afraid

Full Account No is Column D. Account No should begin with specified digit.

What if there is more than one?

eg In post 17 sample data there are cells that have multiple matches for account number starts ..
A3: P25125/6000000453 RW
A6: D-W-10983-3150004927
A9: refu25188/6000000502

In each case you have listed the first of these in your expected results. Just checking: Is that the requirement or you don't care which one is returned, or both should be returned?

 

[Mallesh23]

Hi Peter,

It will be first match, there will not be duplicate account code in actual data. Thanks
it was my typing mistake.

Thanks.
Mg

 

[Peter_SSs]

there will not be duplicate account code in actual data.

In that case try

Sub Get_Account_Number()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "(^|\D)(" & Join(Application.Transpose(Range("D2", Range("D" & Rows.Count).End(xlUp))), "\d*|") & "\d*)(?=\D|$)"
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If RX.Test(a(i, 1)) Then b(i, 1) = RX.Execute(a(i, 1))(0).submatches(1)
  Next i
  Range("B2").Resize(UBound(a)).Value = b
End Sub

 

[Mallesh23]

Hi Peter,

It worked as expected, Millions of thanks for your help. It will Save my lot of time,
Daily we use to check manually 10000 records. ??



Thanks
mg

 

[Peter_SSs]

Glad to help.