Macro to extract few values from a cell

[Johin Chandresh.B]

Hello guys,

can some one please help me with a macro to extract few details from a cell and paste it in a separate cell Please?

Example:
In A1 I have Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213; Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213

In one cell I have a big sentence which contains several (upto 5) Q/0 number, ETA date and order #

I need the output to be Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 in separate cells on the same line.

There are about 2000 lines in excel where I have to do this and as of now am doing it manually.

Can someone who has the knowledge of writing VBA code please help me?

Regards,
Joe

 

[Claus Busch]

Hi Joe,

Am Tue, 17 Sep 2013 10:58:14 -0700 (PDT) schrieb Johin Chandresh.B:

In A1 I have Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213; Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213

In one cell I have a big sentence which contains several (upto 5) Q/0 number, ETA date and order #

I need the output to be Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 in separate cells on the same line.

try in B1:
=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"x",),"dsdsdsd",),";",))
and copy down. Copy the column and Paste Special => Paste Values and
delete column A


Regards
Claus B.

 

[Johin Chandresh.B]

Hi Claus,

Thanks for your reply.

The xxx and dsds are actually information which is not constant across all the cells. The actual data in the cell looks like this

Info in the cell A1

Q/O - 03T7032 QTY - 1 SYSTEM BOARD (PLANAR) ETA 16/08/2013 @ 09:00AM ORDER # - 112348135 Q/O 043N9877 QTY - 1 65W HsFGDDdEAfT SsdFGeNK FadAFfN ETA 16/08/2013 @ 09:00A M ORDER# - 178123235

Info in the cell A2

Q/O = 04W1544; QTY = 1; PART DESC = LCD PANEL; ETA = 22/08/13 11 : 00; ORDER # = 1523242233872; Q/O = 45Md32896 ; QTY = 1; PART DESC = LCD CABLE; ETA = 22/08/13 11 : 00 ; ORDER # = 15287342;

Information keeps changing and the format or the number of characters are not the same. The Q/O, QTY and ETA gets repeated upto 5 time in the same cell.

Please help.

Regards,
Joe

 

[Claus Busch]

Hi Joe,

Am Tue, 17 Sep 2013 11:30:06 -0700 (PDT) schrieb Johin Chandresh.B:

Info in the cell A1

Q/O - 03T7032 QTY - 1 SYSTEM BOARD (PLANAR) ETA 16/08/2013 @ 09:00AM ORDER # - 112348135 Q/O 043N9877 QTY - 1 65W HsFGDDdEAfT SsdFGeNK FadAFfN ETA 16/08/2013 @ 09:00A M ORDER# - 178123235

Info in the cell A2

Q/O = 04W1544; QTY = 1; PART DESC = LCD PANEL; ETA = 22/08/13 11 : 00; ORDER # = 1523242233872; Q/O = 45Md32896 ; QTY = 1; PART DESC = LCD CABLE; ETA = 22/08/13 11 : 00 ; ORDER # = 15287342;

try:

Sub Test()
Dim strTmp As String
Dim strRep As String
Dim LRow As Long
Dim rngC As Range
Dim myStart As Integer
Dim myEnd As Integer

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
strTmp = rngC
Do
myStart = InStr(strTmp, "QTY")
myEnd = InStr(myStart, strTmp, "ETA")
strRep = Mid(strTmp, myStart, myEnd - myStart)
strTmp = Replace(strTmp, strRep, "")
Loop While InStr(strTmp, "QTY") > 0
Do
myStart = InStr(strTmp, ":") - 4
myEnd = myStart + 9
strRep = Mid(strTmp, myStart, myEnd - myStart)
strTmp = Replace(strTmp, strRep, "")
Loop While InStr(strTmp, ":") > 0
rngC.Offset(0, 1) = Trim(Replace(strTmp, ";", ""))
Next
End Sub


Regards
Claus B.

 

[Ron Rosenfeld]

Hello guys,

can some one please help me with a macro to extract few details from a cell and paste it in a separate cell Please?

Example:
In A1 I have Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213; Q/0 "03T6560" xxx xxxxx xxx ETA "16/08/13 09:30"; dsdsdsd Order # 2323213

In one cell I have a big sentence which contains several (upto 5) Q/0 number, ETA date and order #

I need the output to be Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 Q/0 "03T6560" ETA "16/08/13 09:30" Order # 2323213 in separate cells on the same line.

There are about 2000 lines in excel where I have to do this and as of now am doing it manually.

Can someone who has the knowledge of writing VBA code please help me?

Regards,
Joe

Here's a macro that uses regular expressions to tease things out.
I note you have some variability in how you have "Name'd" the various segments.

For example, you show Q/0 and also Q/O (zero and capital "O")
You also show ORDER and Order.

The macro accounts for that, and outputs the data as it exists in the original. However, it would be trivial to standardize it if you desired and provided appropriate rules.

The macro also assumes that your data is in column A, and the results will be written in column B and rightward; and that there is nothing of value to the right of column A

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.



===========================================
Option Explicit
Sub ExtractData()
Dim rSrc As Range, c As Range
Dim i As Long, j As Long
Dim re As Object, mc As Object, m As Object
Set rSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp))
rSrc.Offset(columnoffset:=1).Resize(columnsize:=Columns.Count - rSrc.Column).Clear
Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.ignorecase = True
.Pattern = "(Q/[0O])\W+(\w+).*?(ETA)\D+(\d+/\d+/\d+).*?(\d+)\s*:\s*(\d+).*?(ORDER)\D+(\w+)"
End With

For Each c In rSrc
If re.test(c.Text) = True Then
j = 0
Set mc = re.Execute(c.Text)
For Each m In mc
'Q/O
j = j + 1
c.Offset(columnoffset:=j) = m.submatches(0) & " """ & m.submatches(1) & """"
'ETA
j = j + 1
c.Offset(columnoffset:=j) = m.submatches(2) & " """ & m.submatches(3) & " " & _
m.submatches(4) & ":" & m.submatches(5) & """"
'ORDER
j = j + 1
c.Offset(columnoffset:=j) = m.submatches(6) & " # " & m.submatches(7)
Next m
End If
Next c
End Sub
===========================================