Solved: Extract Data from a Alphnumeric String

[surya prakash]

Hello,
I am wondering if a function can be written in vba to achieve the below


I have alphanumeric text in column A, the function should achieve the following

1) split the data into 3 columns.
2) lookup and replace the dat
eg:

Step 1 (Split data in descp into 2 columns; number before and after the text should be appended in the last column (number).
Descp ID Number
2R1 R 0021
2R12 R 0212
15R25 R 1525
15C26 C 1526


Step 2 (ID has a corresponding number in the excel sheet "ref", function should lookup and replace the text with an appropriate number.

Descp ID Number
2R1 78 0021
2R12 78 0212
15R25 78 1525
15C26 79 1526


Step 1 & step 2 are to be combined, ie splitting and look-up should be perfomed together.

Thanks in advance...

Excel file for ready reference....

[Bob Phillips]

Sub sortit()
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("A:A").TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, _
Other:=False, _
FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Columns("C:C").Insert Shift:=xlToRight
Range("C2").FormulaR1C1 = "=VLOOKUP(RC[-1],ref!C[-2]:C[-1],2,FALSE)"
Range("C2").AutoFill Destination:=Range("C2:C" & iLastRow), Type:=xlFillDefault
Columns("C:C").Copy
Columns("C:C").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Columns(2).Delete
Range("B1:C1").Font.Bold = True
End Sub

[surya prakash]

Hello XLD,
I am getting #N/A as result.
Could you attach your excel sheet please.

thanks again for your time.



#N/A

[surya prakash]

Hello XLD,
Just to add; your macro is working if there is a space in the string.
It works when the string is 12 R 5; it doesnt work when we have 12R5;
I am wondering if there is way out, when there is no space in the data.

Thanks

[Bob Phillips]

Hello XLD,
Just to add; your macro is working if there is a space in the string.
It works when the string is 12 R 5; it doesnt work when we have 12R5;
I am wondering if there is way out, when there is no space in the data.

Thanks

Your requirement was based upon there being a space. How do you know where to split without a space?

[surya prakash]

Sorry XLD, my mistake.

I have deliberately kept the spaces in the message for clarity. (But if you look in the excel attachment, there will not be any spaces), I thought you would check the excel attachment.

Sorry again for confusion.....

[surya prakash]

Hello,
Could somebody respond please.....

[Bob Phillips]

Hello,
Could somebody respond please.....

I for one am confused by what the data starts like. In the example workbook I cannot tell whether the data shown is pre-process or post-process.

[Killian]

Hi surya,
It took me a while to understand what you want - I think I got it...
12R5 would give a number, "0125" and an ID "R" ?

What's needed is to look at each item as a string, get the position of the first alpha character, then look for the last alpha character and manupulate the string into its parts before placing on the sheet with a lookup for the ID and formating the number.

This seems OK to meDim rngTarget As Range
Dim rngLookUp As Range
Dim iLastRow As Long
Dim r As Long
Dim strDescp As String
Dim i As Long
Dim firstchar As Long, lastchar As Long
Dim strID As String
Dim strNum As String
Dim lngCharLen As Long
Dim lngRightPos As Long

Set rngLookUp = Sheets("ref").Range("A2:A7")
iLastRow = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To iLastRow
firstchar = 0
lastchar = 0
Set rngTarget = Sheets("DATA").Cells(r, 1)
strDescp = rngTarget.Text
If strDescp <> "" Then
For i = 1 To Len(strDescp)
If Not IsNumeric(Mid(strDescp, i, 1)) Then
If firstchar = 0 Then
firstchar = i
Else
lastchar = i
End If
End If
Next i
If lastchar = 0 Then
lngCharLen = 1
lngRightPos = firstchar
Else
lngCharLen = lastchar - firstchar + 1
lngRightPos = lastchar
End If
strID = Mid(strDescp, firstchar, lngCharLen)
strNum = Left(strDescp, firstchar - 1) & _
Right(strDescp, Len(strDescp) - lngRightPos)
rngTarget.Offset(0, 1).Value = rngLookUp.Find( _
strID, lookat:=xlWhole).Offset(0, 1).Value
rngTarget.Offset(0, 2).Value = CLng(strNum)
rngTarget.Offset(0, 2).NumberFormat = "0000"
End If
Next r

[surya prakash]

Hello XLD,
The data in Column A is

2R1
2R12
15R25
15C26
15AB26
etc.

Now as you can see, there are some characters in each of the string;
The character has a prefix and suffix.

The prefix, character and suffix have to be seperated into different columns.

[surya prakash]

Just to add;
Prefix and Suffix are usually numbers..

[Killian]

Oh...
If you want the prefix and suffix seperate, then with the code I posted, assign them to their own variables instead of concatenating them'instead of
strNum = Left(strDescp, firstchar - 1) & _
Right(strDescp, Len(strDescp) - lngRightPos)

'do this
strPrefix = Left(strDescp, firstchar - 1)
strSuffix = Right(strDescp, Len(strDescp) - lngRightPos)

[Bob Phillips]

Hello XLD,
The data in Column A is

2R1
2R12
15R25
15C26
15AB26
etc.

Now as you can see, there are some characters in each of the string;
The character has a prefix and suffix.

The prefix, character and suffix have to be seperated into different columns.

and you want to lookup the numeric value corresponding to the alpha part of the string?

[surya prakash]

Many thanks both of you.

I am getting "Run-time error '91': Object variable or with block variable not set" error in the line
rngTarget.Offset(0, 1).Value = rngLookUp.Find(strID, lookat:=xlWhole).Offset(0, 1).Value

Could you please check...

thanks again..

[Killian]

You should check the result ofrngLookUp.Find(strID, lookat:=xlWhole).Offset(0, 1).ValueIf the alpha part of the string, strID, is not found in your ref range, the rngLookUp.Find will return Nothing and this error will be produced in trying to get the Value property of Nothing.

You willl either need to be sure the data is complete or run the .Find first and check the result before trying to use it.

[surya prakash]

Thanks Killian...
Let me just check and revert back...

[surya prakash]

Hello Killian,

I was away and could not respond to your post earlier.

I have slightly modified your code to suit my requirements.

I am coding stage-by-stage and removed vlookup feature at present to make things simple for me.

I am getting "Run-time error '5', Invalid procedure call or argument" error, when I run the module.

I am wondering if you can have a look.

Thanks again..

[Killian]

Hello, welcome back :hi:

The invalid argument is "FirstChar"...
You re-initialize it to 0 at t he start of each loop.
When the target cell hits a Numeric value (A13 is "5"), , it remains zero, which isn't valid for the position index in the Mid function

You could just re-initialize it to 1, which would work.

I think the loop could be simplified a littleDo Until Cells(RowNo, ColNo).Value = "stop"
StrDescp = Cells(RowNo, 1).Text
If StrDescp <> "" Then
For i = 1 To Len(StrDescp)
myChar = Mid(StrDescp, i, 1)
If Not IsNumeric(myChar) Then
StrID = StrID & myChar
End If
Next i
If StrID <> "" Then
Cells(RowNo, ColNo + 1) = StrID
StrID = ""
End If
End If
RowNo = RowNo + 1
Loop
MsgBox "Task Completed", vbOKOnly, "NSP"

[surya prakash]

Hello Killian,

The new code is really cool and simplified, thank you for the same.

I am wondering if we can incorporate the code to split the prefix and suffix from the string such 123ABCD456 into different columns such as

Col2 Col3 col4
123 ABCD 456

thank you for your patience.
surya

[surya prakash]

Hello Killian,

many thanks for your simplified solution.

I have added some code to extract the prefix and suffix to the string in between.
While I am able to extract the prefix, I am not able to extract suffix into a new column.

ie, while I am getting date in col-x and col-y, I am not able get the data in col-z. Can you please suggest me a method.


Colx Coly colz
123 ABCD 456


I am attaching the excel file for your ready reference, please have a look.
Thanks in advance.

[Killian]

Well there are a few different ways to approach this.
If you know your data will always have this format, you can find the positions of the first and last letters and assign your cell values using "Mid" and these positionsDim StrDescp As String
Dim RowNo As Integer, ColNo As Integer
Dim i As Long
Dim FirstAlpha As Long, LastAlpha As Long

RowNo = 2
ColNo = 1

Do Until Cells(RowNo, ColNo).Value = "stop"
StrDescp = Cells(RowNo, 1).Text
If StrDescp <> "" Then

'start from begining to get first alpha
For i = 1 To Len(StrDescp)
If Not IsNumeric(Mid(StrDescp, i, 1)) Then
FirstAlpha = i
Exit For
End If
Next i
'start from FirstAlpha to get last alpha
For i = FirstAlpha To Len(StrDescp)
If IsNumeric(Mid(StrDescp, i, 1)) Then
LastAlpha = i - 1
Exit For
End If
Next i

Cells(RowNo, ColNo + 1) = Mid(StrDescp, 1, FirstAlpha - 1)
Cells(RowNo, ColNo + 2) = Mid(StrDescp, FirstAlpha, LastAlpha - FirstAlpha + 1)
Cells(RowNo, ColNo + 3) = Mid(StrDescp, LastAlpha + 1, Len(StrDescp) - LastAlpha)
End If
RowNo = RowNo + 1
Loop
MsgBox "Task Completed", vbOKOnly, "NSP"

[surya prakash]

Hello Killian,
Many thanks for your timely help.
I am able to solve the problem.

thanks again....

surya