VBA Split Cells and paste only specific cells

Question

updated*

im new to VBA so help would be appreciated

i have a sheet where i have in column A content in this structure:

A1: Columnheader A2: 044000 randomwordx (3 spaces between number and randomwords)
A3: 056789 randomwordy (3 spaces between number and randomwords) A4:

A5: a.) randomwords
A6: 3.randomwords A7:

A8: 600000 randomwordz (3 spaces between number and randomwords)
A9: 654124 randomwords (3 spaces between number and randomwords)

the delimiter between numbers and randomwords in column A is always 3x spaces

what i want to do is the following:

Go to Column A - select all cells which start with a 6-figures number

split these cells and paste them into column C and D
column C should contain only the starting number, remove any leading zeroes (if cell A2 has for example 044000, cell C2 should be 44000)
column D should only contain the text which comes after the starting number of column A (in this example D2 should be "randomwordx"
cells in column A which are blank or dont start with a 6 figure number should NOT be pasted in column C and D (in this example A4,A5,A6,A7 should NOT be pasted into C and D column)

So it should look like this

Column C: C1: Columnheader

C2:44000

C3:56789

C4:60000

C5:653124

Column D:

D1: Columnheader

D2:randomwordx

D3:randomwordy

D4:randomwordz

D5:randomwords

I managed only to get this far, so help would be appreciated

Option Explicit

Sub Splitcolumn() 
Dim mrg As Range
Dim LastRow As Long
Dim r As Range
Dim splitted() As String

With Sheets("test")
    Set mrg = Sheets("test").Range("A4:A" & LastRow)
    For Each r In mrg 
        splitted = Split(r.Value, "   ") 
        r.Value = splitted(0)
        r.Offset(2, 3).Value = splitted(1) & "   " & splitted(2)
    Next r
End With
End Sub

i received runtime error 1004

thanks for your help

You should mention what is happening and where are you stuck. Any runtime error? Is the code doing something that you didn't expect? Does nothint at all? Have you used the Debugger to check? Assuming that you show us all your code: You never assign anything to `LastRow`, so it will be `0` and that will throw a runtime error as the range `A4:A0` is invalid. — FunThomas, Mar 19 '19 at 09:37
This sounds to me as if you started coding before your plan was thought out. Can you add an exact description in words of what you want your code to do? For example: Go to this cell; if x then do y, if not x then do z; repeat for this number of cells etc.; include ALL steps you want your code to have, this should take you no more that 10 minutes; Please update your question accordingly. — , Mar 19 '19 at 10:12

Tyler N · Accepted Answer · 2019-03-19T14:35:34.840

This should do what you want it to. I used Portland Runner's answer to this post to set up the RegEx reference in my VBA and learn the syntax for it. Instead of a for each loop, I calculate the last row of column A and use a for loop with that many iterations. The i variable is set to 2 to skip the header in row 1.

Sub SplitCol()
    'Set references to active workbook and sheet
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet

    'Create Regular Expression object and set up options
    Dim regEx As New RegExp
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        '[0-9] means that regex will check for all digits
        '{6} means that a minimum of 6 consecutive chars must meet the [0-9] criteria
        .pattern = "[0-9]{6}"
    End With

    'All .Methods and .Properties will belong to ws object due to With
    With ws
        'Determine how many rows to loop through
        Dim lastRowA As Long
        lastRowA = .Range("A" & .Rows.Count).End(xlUp).Row

        'Main loop
        Dim i As Integer
        For i = 2 To lastRowA
            'Make sure there is a value in the cell or code will error out
            If Cells(i, 1).Value <> "" Then
                'Test regex of cell
                If regEx.Test(Split(Cells(i, 1).Value, "   ")(0)) Then
                    'If regex was true, set 3rd column (C) equal to numbers and
                    '4th column (D) equal everything else
                    Cells(i, 3).Value = Split(Cells(i, 1).Value, "   ")(0)
                    Cells(i, 4).Value = Split(Cells(i, 1).Value, "   ")(1)
                End If
            End If
        Next
    End With

    'Release regEx object to reduce memory usage
    Set regEx = Nothing

End Sub

This is what the code should make the sheet look like.

thank you very much Tyler, this helps me a lot! Your Solution is almost perfect, only thing which troubles me is that sometimes in column A a single digit is in front of the text (in my example above, in A6 i have the content " 3.randomwords") which should be ignored and not split and copied to C & D. i think i can fix it myself, just wanted to let you know. — croyx, Mar 19 '19 at 13:47
@croyx You're very welcome. I made a slight edit to the code if you take a look. I changed the .pattern of the RegEx to include {6} which will make it so that a minimum of 6 consecutive characters must meet the [0-9] criteria. I tested it and it prevented "3.randomword" from getting copied - hope that helps. — Tyler N, Mar 19 '19 at 14:37

VBA Split Cells and paste only specific cells

1 Answers1