-
If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
Macro for extracting data
- Thread starter sparkerk1
- Start date
Excel Facts
Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
hi
based on the code below just a small adjustment required , it should remove the highlighted part also
J5CG4Z
BOMVS316E/2005NM/5JUL20
1.SINGH/RANGPAL MR
2 QR 146 H 10JUL 5 BCNDOH HK1 1440 2145 10JUL E QR/J5CG4Z
3 VR 053 Y 11JUL 6 DOHDEL GK1 0800 1405 11JUL SUKANYA
Sub test()
Dim a, i As Long, m As Object, dep, des, txt As String
With Range("a1", Range("a" & Rows.Count).End(xlUp))
a = .Value
With CreateObject("VBScript.RegExp")
.Global = True
For i = 2 To UBound(a, 1)
txt = a(i, 1)
.Pattern = "[^\u0021-\u007F]+"
txt = Application.Trim(.Replace(txt, " "))
.Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
"([A-Z]{3}) *([A-Z]{2}\d+) *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
If .test(txt) Then
Set m = .Execute(txt)(0).submatches
dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
If IsError(dep) Then dep = m(3)
If IsError(des) Then des = m(4)
a(i, 1) = Application.Trim(.Replace(txt, "$1 $2 $3 " & dep & " " & des & " $6 $7 $8 "))
End If
Next
End With
.Value = a
End With
End Sub
based on the code below just a small adjustment required , it should remove the highlighted part also
J5CG4Z
BOMVS316E/2005NM/5JUL20
1.SINGH/RANGPAL MR
2 QR 146 H 10JUL 5 BCNDOH HK1 1440 2145 10JUL E QR/J5CG4Z
3 VR 053 Y 11JUL 6 DOHDEL GK1 0800 1405 11JUL SUKANYA
Sub test()
Dim a, i As Long, m As Object, dep, des, txt As String
With Range("a1", Range("a" & Rows.Count).End(xlUp))
a = .Value
With CreateObject("VBScript.RegExp")
.Global = True
For i = 2 To UBound(a, 1)
txt = a(i, 1)
.Pattern = "[^\u0021-\u007F]+"
txt = Application.Trim(.Replace(txt, " "))
.Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
"([A-Z]{3}) *([A-Z]{2}\d+) *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
If .test(txt) Then
Set m = .Execute(txt)(0).submatches
dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
If IsError(dep) Then dep = m(3)
If IsError(des) Then des = m(4)
a(i, 1) = Application.Trim(.Replace(txt, "$1 $2 $3 " & dep & " " & des & " $6 $7 $8 "))
End If
Next
End With
.Value = a
End With
End Sub
Upvote
0
... The above code is not my code nor can I edit it
Fluff
MrExcel MVP, Moderator
- Joined
- Jun 12, 2014
- Messages
- 90,784
- Office Version
- 365
- Platform
- Windows
Cross posted Macro required to skip rows if there is a . Between in the data [SOLVED]
and macro to delete unwanted characters and give output on the same cel
While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
and macro to delete unwanted characters and give output on the same cel
While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
Upvote
0
Similar threads
- Solved
- Question
