1

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.

Improve this question

2 Answers 2

Reset to default
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
Improve this answer
Sign up to request clarification or add additional context in comments.

7 Comments

Thanks very much. There are two issues,though. First: it deletes the righter cell's contents instead of shifting them to the right. Second: Is it possible to run the macro for a whole column with data in it. i.e.,Select column A and run for all non-empty cells,instead of running for 100 (or for any hard coded number of) cells.
@bonsvr, I have updated the code to run for all non-empty cells and to shift column B to the right. Hope this helps.
What line of code does the error occur on? How many lines of the spreadsheet does it process? Could you post some sample data? I was able to get the code to run OK with the data I was using.
Sorry. It was For i = 1 To lngLastRow. I applied it to test data. I mean 2-3 rows on a fresh worksheet. It didnt process at all.
I've changed the code to use the activecell column instead of hard-coding. Hope this works for you.l
|
0

How about:

Sub UpdateCells()
Dim rng As Range
Dim c As Range
Dim l As Long
Dim s As String, a As String, b As String

''Working with sheet1 and column C
With Sheet1
    l = .Range("C" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("C1:C" & l)
End With

''Working with selected range from above
For Each c In rng.Cells
    If c <> vbNullString Then
        s = FirstNonNumeric(c.Value)

        ''Split the string into numeric and non-numeric, based
        ''on the position of first non-numeric, obtained above. 
        a = Mid(c.Value, 1, InStr(c.Value, s) - 1)
        b = Mid(c.Value, InStr(c.Value, s))

        ''Put the two values on the sheet in positions one and two 
        ''columns further along than the test column. The offset 
        ''can be any suitable value.
        c.Offset(0, 1) = a
        c.Offset(0, 2) = b
    End If
Next
End Sub

Function FirstNonNumeric(txt As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^0-9]"
        FirstNonNumeric = .Execute(txt)(0)
    End With
End Function
Improve this answer

4 Comments

sorry it doesnt work. nothing happens if there is no data in 2th column, otherwise it copies column 3(C) to column 5(E).
@bonsvr I tested using column C for the data to be split, you need to change column C to the column for your data in the lines after "with sheet1", similarly, if your sheet is other than sheet1, this also need to be changed.
Thanks Remou. It splits the data and places into adjacent cells, however it deletes the data in columns E and F. It should insert a column into D and shift the right columns righter. And it would be good if it were column independent, i.e. worked for the selected column instead of only column C or any other hardcoded one.
@bonsvr I cannot see your sheets, the idea is that I provide sample code and you take the code and alter it to suit your exact situation. I will add a further note to the sample.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.