Macro for extracting data

[sparkerk1]

hi

i have below sample data , from which i want to extract only certain value only

5 TK 468 M 06JUL 1 ODSIST HK4 2140 2305 06JUL E TK/VGRWLL

Output required

TK 468 06JUL ODSIST 2140 2305 06JUL TK/VGRWLL

 

[mse330]

Hi sparkerk,

With the very limited information supplied & only 1 example to work with, give the below code a try ...

Sub test()

Dim c As Range, j$

For Each c In Range("A2", Range("A" & Rows.Count).End(3)) '<-- change range as needed
   For x = 1 To 12
      Select Case x
         Case 1, 2, 4, 6, 8 To 10, 12: j = IIf(Len(j) = 0, Split(c)(x), j & " " & Split(c)(x))
      End Select
   Next
   c = j: j = vbNullString
Next

End Sub

 

[sparkerk1]

hi

Please find some examples for reference

Eg 1

PT3U5G

BOMVS316E/2005NM/3JUL20

1.DUBEY/PRASHANT MR

2 QR 743 K 03JUL 5 DOHBOS HK1 0800 1415 03JUL E QR/PT3U5

Eg 2

MSPSGM

BOMVS316E/2005NM/2JUL20

1.SAURAV/SAJAL MR 2.SUVARNA/RAHUL MR 3.VERMA/DEEPAK MR

4 QR 729 K 10JUL 5*DOHDFW HK3 0750 1530 10JUL E QR/MSPSGM

5 QR2720 K 10JUL 5*DFWIAH HK3 1855 2008 10JUL E QR/MSPSGM

For Eg1 tried ur code got below result

2 QR K 5 DOHBOS HK1 0800

Data should be extracted from only the lines mentioned in line 2 of Eg 1 and line 4 and 5 of eg 2,

output required should be as below

for eg 1

QR 743 03JUL DOHBOS 0800 1415 03JUL QR/PT3U5


for eg 2

QR 729 10JUL DOHDFW 0750 1530 10JUL QR/MSPSGM

QR2720 10JUL DFWIAH 1855 2008 10JUL QR/MSPSGM

 

[mse330]

OK, try the revised code ... I think if you have more patterns then a RegEx is required

Sub test()

Dim c As Range, j$
For Each c In Range("A2", Range("A" & Rows.Count).End(3)) '<-- change range as needed
   If UBound(Split(c)) >= 10 Then
      c.Replace "~*", " "
      If c Like "? ?? ###*" Then c.Value = Left(c, 4) & "|" & Mid(c, 6)
         For x = 1 To 11
            Select Case x
               Case 1, 3, 5, 7 To 9, 11: j = IIf(Len(j) = 0, Split(c)(x), j & " " & Split(c)(x))
            End Select
         Next
      c = j: j = vbNullString
      c.Replace "|", " "
   End If
Next

End Sub

Book1
	A	B	C
1	Input	Expected Output	Check
2	PT3U5G	PT3U5G	TRUE
3	BOMVS316E/2005NM/3JUL20	BOMVS316E/2005NM/3JUL20	TRUE
4	1.DUBEY/PRASHANT MR	1.DUBEY/PRASHANT MR	TRUE
5	2 QR 743 K 03JUL 5 DOHBOS HK1 0800 1415 03JUL E QR/PT3U5	QR 743 03JUL DOHBOS 0800 1415 03JUL QR/PT3U5	FALSE
6			TRUE
7	MSPSGM	MSPSGM	TRUE
8	BOMVS316E/2005NM/2JUL20	BOMVS316E/2005NM/2JUL20	TRUE
9	1.SAURAV/SAJAL MR 2.SUVARNA/RAHUL MR 3.VERMA/DEEPAK MR	1.SAURAV/SAJAL MR 2.SUVARNA/RAHUL MR 3.VERMA/DEEPAK MR	TRUE
10	4 QR 729 K 10JUL 5*DOHDFW HK3 0750 1530 10JUL E QR/MSPSGM	QR 729 10JUL DOHDFW 0750 1530 10JUL QR/MSPSGM	FALSE
11	5 QR2720 K 10JUL 5*DFWIAH HK3 1855 2008 10JUL E QR/MSPSGM	QR2720 10JUL DFWIAH 1855 2008 10JUL QR/MSPSGM	FALSE
12			TRUE
13	5 TK 468 M 06JUL 1 ODSIST HK4 2140 2305 06JUL E TK/VGRWLL	TK 468 06JUL ODSIST 2140 2305 06JUL TK/VGRWLL	FALSE
Sheet2

Cell Formulas
Range	Formula
C2:C13	C2	=A2=B2

 

[sparkerk1]

hi

tried your above code didn't work

Example:

PPEP7N
BOMVS316E/1133KM/7JUL20
1.ASHISH BOLA/MR 2.KAUSHAL/ABNISH MR 3.PINTO/DERYL MR
4 QR 067 K 06JUL 1 DOHFRA HK3 0755 1330 06JUL E QR/PPEP7N
5 LH 026 M 06JUL 1 FRAHAM HK3 1730 1835 06JUL E LH/PPEP7N

getting below results

PPEP7N

BOMVS316E/1133KM/7JUL20

BOLA/MR MR MR

067 06JUL 1 DOHFRA

026 06JUL 1 FRAHAM

 

[mse330]

Hi,

I have tried the code in post #4 and I get different results than the one you posted ? ... This is what I get

Book1
	A	B
1	Input	Output
2	PPEP7N	PPEP7N
3	BOMVS316E/1133KM/7JUL20	BOMVS316E/1133KM/7JUL20
4	1.ASHISH BOLA/MR 2.KAUSHAL/ABNISH MR 3.PINTO/DERYL MR	1.ASHISH BOLA/MR 2.KAUSHAL/ABNISH MR 3.PINTO/DERYL MR
5	4 QR 067 K 06JUL 1 DOHFRA HK3 0755 1330 06JUL E QR/PPEP7N	QR 067 06JUL DOHFRA 0755 1330 06JUL QR/PPEP7N
6	5 LH 026 M 06JUL 1 FRAHAM HK3 1730 1835 06JUL E LH/PPEP7N	LH 026 06JUL FRAHAM 1730 1835 06JUL LH/PPEP7N
Sheet1

 

[sparkerk1]

hi i have made a file , kindly how can i attach the same here so u can have look and advise me where i am going wrong

 

[mse330]

You can’t attach files .. Upload the file in DropBox (or similar cloud folder) & share the link with us

 

[sparkerk1]

Book1.xlsx

drive.google.com

hope this helps

 

[mse330]

Well, based on your excel file, there are some leading/trailing & double spacing in the data. I have added one line to take care of that. Give it a try now

Note: The code will NOT work for this example [ 3 VR 053 Y 11JUL 6 DOHDEL GK1 0800 1405 11JUL SUKANYA] as it is missing the letter after the date 11JUL which is another pattern

Sub test()

Dim c As Range, j$
For Each c In Range("A2", Range("A" & Rows.Count).End(3)) '<-- change range as needed
   If UBound(Split(c)) >= 10 Then
      c.Replace "~*", " "
      c = Application.Trim(c)
      If c Like "? ?? ###*" Then c.Value = Left(c, 4) & "|" & Mid(c, 6)
         For x = 1 To 11
            Select Case x
               Case 1, 3, 5, 7 To 9, 11: j = IIf(Len(j) = 0, Split(c)(x), j & " " & Split(c)(x))
            End Select
         Next
      c = j: j = vbNullString
      c.Replace "|", " "
   End If
Next

End Sub