Split Cell and Insert (not replace) the new cells

[riz.hossain]

Hello Everyone,

Below is a code that I got from this webpage. This is pretty much what I need except for me, I need to make sure that splited cells do not replace content of other cells. For example, if A1 has "SDR232, SDR634", this code will split them and put A1 to be "SDR232" and A2 to be "SDR634". BUT what it does is that it actually replaces whatever I have in A2. Is ther anyway to avoid replacing the content of A2?

Thanks in advance for whoever had a chance to look at it!

Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

 

[VoG]

Try

Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
Range("A2").Resize(UBound(X)).Insert shift:=xlShiftDown
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

 

[VoG]

Correction (in case A1 has only one value)

Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
If UBound(X) > 0 Then Range("A2").Resize(UBound(X)).Insert shift:=xlShiftDown
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

 

[riz.hossain]

Thanks a LOT! for the code!!
So I used the code below. There are two things that I need:

1: If the cell is blank, I get a run time error "13"; type mismatch.
2: There are white spaces added.. i would need to remove those as well. For example if my cell has "SDR34343, SDR3443" I get " SDR3443". I know I am asking for a lot, but if I can remove the white spaces that would be GREATE!!!

Thanks again!!! I really appriciate your help!



Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
If UBound(X) > 0 Then Range("A2").Resize(UBound(X)).Insert shift:=xlShiftDown
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

 

[VoG]

Try

Sub tst()
Dim X As Variant
If Range("A1").Value = "" Then Exit Sub
X = Split(Replace(Range("A1").Value, " ", ""), ",")
If UBound(X) > 0 Then Range("A2").Resize(UBound(X)).Insert shift:=xlShiftDown
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub

 

[ToddOdd]

I actually need to do something similar, but not sure I get what method will achieve a slightly different result. So here's my problem:

I need to split a cell that has data of first name, last name and title into 3 separate cells. My data looks like this:

JohnSmith - Owner

My plan is to split this cell into 3 new columns which will be adjacent right to the cell with the data. I am running an iterative process over 900 names.

Anyone suggest how I might change the code provided to:
1) move the data into my 3 blank columns
2) Split based on a capital letter (ooh, there's a good one); and
3) make it iterative so that I run the macro just once over the whole list.

Like my fellow poster, I may have blank cells and need the error handling that would keep this macro running.

Thanks in advance. Great to find this place!

ToddOdd

 

[VoG]

Hello and welcome to MrExcel.

Look here http://www.cpearson.com/excel/FirstLast.htm

 

[riz.hossain]

WoW! thanks for your prompt reply!!

Okay so now i am trying to loop through your code, but i face the issue where i have two blank cell back to back .....

I just dont know how to use the Go To function here ..... i think i just need to say Go To the line that actually does i+1 instead of just trying to add i+1 under if condition .....


And i also need to address the issue with white space at the begining ... (if possible!)



Private Sub CommandButton1_Click()
Set Start = Range("A1")
Dim i
Dim j
i = 1

Do Until Range("A" & i) = "END"
j = i + 1
Dim X As Variant

If Range("A" & i).Value = "" Then i = i + 1
X = Split(Range("A" & i).Value, ",")
If UBound(X) > 0 Then Range("A" & j).Resize(UBound(X)).Insert shift:=xlShiftDown
Range("A" & i).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
i = i + 1
Loop



End Sub

 

[VoG]

Try

Sub tst()
Dim X As Variant, LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    If Range("A" & i).Value <> "" Then
        X = Split(Replace(Range("A" & i).Value, " ", ""), ",")
        If UBound(X) > 0 Then Range("A" & i + 1).Resize(UBound(X)).Insert shift:=xlShiftDown
        Range("A" & i).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
    End If
Next i
End Sub

 

[ToddOdd]

Hi:

Thanks for the suggested article; however, it doesn't do what I need to do because my name string has no comma or delimiter between the two parts of the name... just a capital letter.

JohnSmith (sadly, not John Smith or John,Smith).

Any hints on this one, short of manually fixing?

ToddOdd