Separating strings from numbers with Excel VBA

Question

I need to

a) separate strings from numbers for a selection of cells

and

b) place the separated strings and numbers into different columns.

For example , Excel sheet is as follows:

     A1          B1
  100CASH     etc.etc.

The result should be:

   A1            B1          C1
  100           CASH       etc.etc.

Utilization of regular expressions will be useful, as there may be different cell formats,such as 100-CASH, 100/CASH, 100%CASH. Once the procedure is set up it won't be hard to use regular expressions for different variations.

I came across a UDF for extracting numbers from a cell. This can easily be modified to extract string or other types of data from cells simply changing the regular expression.

But what I need is not just a UDF but a sub procedure to split cells using regular expressions and place the separated data into separate columns.

I've also found a similar question in SU, however it isn't VBA.

Answer 1

See if this will work for you:

UPDATED 11/30:

Sub test()

    Dim RegEx As Object
    Dim strTest As String
    Dim ThisCell As Range
    Dim Matches As Object
    Dim strNumber As String
    Dim strText As String
    Dim i As Integer 
    Dim CurrCol As Integer


    Set RegEx = CreateObject("VBScript.RegExp")
    ' may need to be tweaked
    RegEx.Pattern = "-?\d+"

    ' Get the current column
    CurrCol = ActiveCell.Column

    Dim lngLastRow As Long
    lngLastRow = Cells(1, CurrCol).End(xlDown).Row

    ' add a new column & shift column 2 to the right
    Columns(CurrCol + 1).Insert Shift:=xlToRight

    For i = 1 To lngLastRow  ' change to number of rows to search
        Set ThisCell = ActiveSheet.Cells(i, CurrCol)
        strTest = ThisCell.Value
        If RegEx.test(strTest) Then
            Set Matches = RegEx.Execute(strTest)
            strNumber = CStr(Matches(0))
            strText = Mid(strTest, Len(strNumber) + 1)
            ' replace original cell with number only portion
            ThisCell.Value = strNumber
            ' replace cell to the right with string portion
            ThisCell.Offset(0, 1).Value = strText
        End If
    Next

    Set RegEx = Nothing
End Sub