Split strings in excel (vba)

Question

I am currently using this code(from a fellow user here) to find every cell in column b1 and to find the ones that contain a ";" something like "hello;goodbye". The code will split the cell at the ";" and place "goodbye" directly beneath "hello;" on an entirely new row..

What I need now is this... if a cell contains multiple ";" (ie "hello;goodbye;yo;hi;hey") it will split at EACH ";" not just the first and then move each to a new row directly beneath the other...

What changes do I need to make?

Dim r1 As Range, r2 As Range
Dim saItem() As String


For Each r1 In ActiveSheet.Range("B1", Cells(Application.Rows.Count, 2).End(xlUp))
If InStr(1, r1.Value2, ";") > 0 Then
saItem = Split(r1.Value2, ";")
r1 = Trim$(saItem(0)) & ";"
r1.Offset(1).EntireRow.Insert (xlDown)
r1.Offset(1) = Trim$(saItem(1))
End If
Next r1

Solution 1

I found an answer over at

http://www.excelforum.com/excel-programming/802602-vba-macro-to-split-cells-at-every.html

This is the solution I was given:

Sub tgr()

Dim rindex As Long
Dim saItem() As String

For rindex = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
    If InStr(Cells(rindex, "B").Value, ";") > 0 Then
        saItem = Split(Cells(rindex, "B").Value, ";")
        Rows(rindex + 1 & ":" & rindex + UBound(saItem)).Insert
        Cells(rindex, "B").Resize(UBound(saItem) + 1).Value =     WorksheetFunction.Transpose(saItem)
    End If
Next rindex

End Sub

Solution 2

I know it's close to what you have, but I wanted to suggest you use Application.ScreenUpdating. This will save considerable time, especially when inserting/deleting rows in Excel. I also wanted to suggest you change the variable names to somehting a little more meaningful.

Sub SplitCells()

Application.ScreenUpdating = False
Dim strings() As String
Dim i As Long

For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
    If InStr(Cells(i, 2).Value, ";") <> 0 Then
        strings = Split(Cells(i, 2).Value, ";")
        Rows(i + 1 & ":" & i + UBound(strings)).Insert
        Cells(i, 2).Resize(UBound(strings) + 1).Value = _
        WorksheetFunction.Transpose(strings)
    End If
Next

Application.ScreenUpdating = True

End Sub

P.S. Smaller alterations is to use "2" instad of "B". If you are using cells() instead of Range(), may as well go all the way :)