VBA - Split Data into 4 columns

[Mallesh23]

Hi Team,

Need your help in splitting Data, Expecting 90% accuracy... if not possible 100% as data is not structured.
Column A is Consolidated Invoices of all Company's. hence data is unstructured.

Logic as follows:-
Split the Data of Column A, with Charecter "/","-","Blank",

if there is a Join of Number and Text split that also separating number and text.

After Splitting Column A

If there are two Numbers - Big Length of Number is Invoice no - Put it in Column B and
Small Length of Number put into Column C. as product Code,


also if there are two text after split , Big text in Column D as Abbreviation
Small text is in Column E as Abbreviation.

If 3 text after split, put 3 split in column F.

Below is a Table with Expected output is in Column B,C,D

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

Below solution extract Invoices in Column B...works successfually. Got solution from this forum only. Need Extra output in C,D,E,F Columns/CODE]


	
	
	
	
	
	



	
	

		
Sub Extract()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
   
    Dim str_Out As String
    Dim s As String
   
   
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row
   
       
    For i = 2 To lr
           
        s = sh.Cells(i, 1)
     
        sh.Cells(i, 2).Value = ExtractInvoices(s)
   
    Next i


    MsgBox "Macro successful"

End Sub



Public Function ExtractInvoices(ByVal s As String) As String
Dim i As Long, k As Long, v As Variant
For i = 1 To Len(s)
    If IsNumeric(Mid(s, i, 1)) = False Then Mid(s, i, 1) = " "
Next
For Each v In Split(Application.Trim(s), " ")
    If Len(v) > k Then
        k = Len(v)
        ExtractInvoices = v
    End If
Next

End Function
	



Thanks
mg

 

[mikerickson]

I'm at work, but there's a non VBA approach I'll be getting back to you about.

 

[mikerickson]

In G2, put =TRIM(SUBSTITUTE(SUBSTITUTE(A2,"-"," "),"/"," ")) to turn all the delimiters into spaces
In H2, =REPT(" ",256)&SUBSTITUTE(G2," ",REPT(" ",255)) to spread them all out
In J2 =TRIM(MID($H2,COLUMN(A1)*255,255)) to return the first delimited item. Drag right to M2 for the other items.
In O2 and dragged right to R2,=IF(ISNUMBER(J2+0),J2+0,J2) to turn the numerals in J2:M2 into numbers
Then the results columns
In T2, =IF(COUNT(O2:R2)>0,MAX(O2:R2),"-")
In U2, =IF(COUNT(O2:R2)>1,MIN(O2:R2),"-")
In V2, =IF(ISNUMBER(O2),IF(ISNUMBER(P2),Q2,P2),O2)
And in W2 =TRIM((SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LEFT($G2,LEN($A2)+2),T2," ",1),U2," ",1),V2," ")))

You will still have to deal with some situations by hand, like row 38 where the spaces are data and not delimiters.

 

[Mallesh23]

Hi Mikerickson,

Works great, millions of thank for your effort , it worked as expected. ?



Thanks
mg