Help with Text String Separation Macro

Frank3923

Board Regular
Joined
Jan 20, 2003
Messages
244
I have found the following code, I need to make some changes to it, and I cannot identify, where to make the changes.
Currently In “Column C” I have cells that have text, that I need to split out, based on the word “at”.
The Code shown below does split the text out as needed, however it is being Split, with the left portion of the string, going into “Column E”, and the Right portion of the string, going into “Column F”, of the same row.
The desired results is to have the Left portion of the string to be in “Column C”, OFFSET 1 row down,
And the Right Portion of the string to be in “Column C”, OFFSET 2 rows down.
If some would be kind enough to show me where the changes, need to be made, and what method, would best be used to do this, I would appreciate it.
Thank you in advance.
Sub ptest()
Dim b!, y, p, i!, k(), e
With Range("C1", Range("C" & Rows.Count).End(xlUp)).Resize(, 1)
p = .Value
End With
ReDim k(1 To UBound(p, 1), 1 To 2)
For i = 1 To UBound(p, 1)
b = 1
For Each e In Split(p(i, 1), " at ")
k(i, b) = e
b = 1 + b
Next
Next
Range("e1").Resize(i, 2).Value = k
End Sub
<html><head><title>Excel Jeanie HTML</title></head><body>

<!-- ######### Start Created Html Code To Copy ########## -->

Excel Workbook
ABCDEFG
1*******
2**Madison at Polk*MadisonPolk*
3*******
4**Van Ness at Fell*Van NessFell*
5*******
6*******
7**Desired Results****
8**Madison at Polk****
9**Madison****
10**Polk****
11*******
12*******
13**Van Ness at Fell****
14**Van Ness****
15**Fell****
16*******
Sheet1




<!-- ######### End Created Html Code To Copy ########## -->

</body></html>
 
Last edited:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Try this with a copy of your sheet

Code:
Sub splt()
Dim LR As Long, i As Long, x
LR = Range("C" & Rows.Count).End(xlUp).Row
Columns("D").Insert
For i = 1 To LR
    x = Split(Range("C" & i).Value, " at ")
    Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(x) + 1).Value = Application.Transpose(x)
Next i
Columns("C").Delete
End Sub
 
Upvote 0
Thank you. I have tried it and I am getting an error message.

Run-time error '13':

Type mismatch

errors out on this line - it Highlights to "YELLOW"

Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(x) + 1).Value = Application.Transpose(x)
 
Upvote 0
That would fail if there wasn't an at. Try

Code:
Sub splt()
Dim LR As Long, i As Long, x
LR = Range("C" & Rows.Count).End(xlUp).Row
Columns("D").Insert
For i = 1 To LR
    x = Split(Range("C" & i).Value, " at ")
    If UBound(x) > 0 Then
        Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(x) + 1).Value = Application.Transpose(x)
    Else
        Range("D" & Rows.Count).End(xlUp).Offset(1).Value = x(0)
    End If
Next i
Columns("C").Delete
End Sub
 
Upvote 0
VoG

It now errors out on this line and Column "D" remain empty.

Range("D" & Rows.Count).End(xlUp).Offset(1).Value = x(0)

Any idea?? I double checked finding the " at " in column C, with another method and it found it and split to the other columns, has I previously mentioned.
 
Upvote 0
This is about as bullet proof as I can make it.

Before

Excel Workbook
C
1
2fred at christmas
3#N/A
4Madison at Polk
5g at b at c
Sheet1




Code:
Sub splt()
Dim LR As Long, i As Long, x
LR = Range("C" & Rows.Count).End(xlUp).Row
Columns("D").Insert
For i = 1 To LR
    If Not IsError(Range("C" & i)) Then
        x = Split(Range("C" & i).Value, " at ")
        If UBound(x) > 0 Then
            Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(x) + 1).Value = Application.Transpose(x)
        Else
            Range("D" & Rows.Count).End(xlUp).Offset(1).Value = Range("C" & i).Value
        End If
    End If
Next i
Columns("C").Delete
End Sub

After

Excel Workbook
C
1
2fred
3christmas
4Madison
5Polk
6g
7b
8c
Sheet1
 
Upvote 0

Forum statistics

Threads
1,224,600
Messages
6,179,834
Members
452,947
Latest member
Gerry_F

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top