Extracting Letters and Numbers in a random Alphanumeric String

**rajbhar_s** · 12-29-2009, 09:28 PM

Hi All,

I've got this problem: I need to separate around 40 alphanumerical entry in Column'A' to Columns'B','C','D','E'..

So, my Column'A' looks like,

A
1 5222208
2 T_5222213
3 522MN2207
4 TCM

And, I need the solution as, Column'A' -> Column'B' | Column'C' | Column'D' | Column'E'

i.e,

5222208 -> 5222208
T_5222213 -> T_ | 5222213
522MN2207 -> 522 | MN |2207
TCM -> TCM
A_522FOV1808 -> A_ | 522 | FOV | 1808
522DV2211 -> 522 | DV |2211

I read previous Threads and found no solution to this.

Please suggest.

Sanjay

**pike** · 12-30-2009, 12:13 AM

could use someting like

Option Explicit
Sub ptest()
Dim RegEx      As VBScript_RegExp_55.RegExp
Dim Myrange As Range, C As Range
    Set RegEx = New VBScript_RegExp_55.RegExp
    Set Myrange = ActiveSheet.Range("A1:A12")
    With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "([0-9]+)"
    For Each C In Myrange
        C.Offset(0, 1) = RegEx.Replace(C, "," & "$1" & ",")
     Next
    Set Myrange = Nothing
    Set RegEx = Nothing
End Sub

to delimite the text then split it up

**pike** · 12-30-2009, 12:54 AM

or all togeather

Option Explicit
Sub ptest()
Dim RegEx As Object, b(), i, z, e
Dim Myrange As Range, C As Range
 ReDim b(1 To 12, 1 To 1)
    Set RegEx = CreateObject("vbscript.regexp")
    Set Myrange = ActiveSheet.Range("A2:A12")
    With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "([0-9]+)"
      For Each C In Myrange
       i = i + 1
       b(i, 1) = RegEx.Replace(C, "," & "$1" & ",")
    
     Next
         End With
       For i = 1 To 12
          z = 2
            For Each e In Split(b(i, 1), ",")
         
         e = Trim(e)
         Debug.Print e
             
          If Not IsEmpty(e) Then
        Cells(i + 1, z) = e
        
      z = 1 + z
    End If
        Next
Next
    Set Myrange = Nothing
    Set RegEx = Nothing
End Sub

**lecxe** · 12-30-2009, 07:21 AM

Hi Sanjay

Assuming the values in a contiguous range in A1, down, try:

Sub Test()
Dim rRng As Range, rC As Range

    Set rRng = ActiveSheet.Range("A1", Range("A1").End(xlDown))
    
    With CreateObject("vbscript.regexp")
        .Pattern = "(\d)(\D)|(\D)(\d)"
        .Global = True
        
        For Each rC In rRng
            rC.Offset(, 1) = .Replace(rC, "$1$3,$2$4")
        Next rC
        rRng.Offset(, 1).TextToColumns DataType:=xlDelimited, Comma:=True
    End With
End Sub

**rajbhar_s** · 12-31-2009, 06:21 PM

Thanks a million Guys!!!!!

Pikes trick worked well!!

**pike** · 01-02-2010, 07:59 AM

Hey rajbhar_s can you please mark the post solved?

**pike** · 01-03-2010, 08:07 AM

This is better using the match collection

Sub ttester()
    Dim p, i, k, e
    Dim myMatches As Object
    Dim myMatch As Object
Set p = ActiveSheet.Range("A2:A12")
    Set i = CreateObject("vbscript.regexp")
   With i
   .IgnoreCase = True
   .Global = True
    .Pattern = "(\d+)|([a-zA-Z+]+)"
    For Each k In p
  e = 0
    Set myMatches = i.Execute(k)
    For Each myMatch In myMatches
        e = e + 1
      k.Offset(0, e) = myMatch.Value
Next
Next
End With
End Sub