Create rows from existing rows

[Joe K.]

I have a spreadsheet in the format listed below. I would like to
spreadsheet each number separated by semi colons into a new records.

Please help me with excel VBA code to complete this task.

Thanks,


Column A Column B Column C
Colorado 1;4;6;11;25 Denver
Florida 24;38;44;12 Miami
Illinois 13;7;8;9;10 Chicago


Desire Output
Column A Column B Column C
Colorado 1 Denver
Colorado 4 Denver
Colorado 6 Denver
Colorado 11 Denver
Colorado 25 Denver
Florida 24 Miami
Florida 38 Miami
Florida 44 Miami
Florida 12 Miami
Illinois 13 Chicago
Illinois 7 Chicago
Illinois 8 Chicago
Illinois 9 Chicago
Illinois 10 Chicago

 

[Bernie Deitrick]

Joe,

The macro below was written on the assumption that you have headers in row 1, and your first data
point to be split is in row 2.

If you want to retain the original sheet, copy the sheet before running the macro.

HTH,
Bernie
MS Excel MVP

Sub JoeSplit()
Dim myC As Range
Dim myV As Variant
Dim i As Integer
Dim myR As Long

For myR = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
myV = Split(Cells(myR, 2).Value, ";")
Cells(myR, 2).EntireRow.Copy
If UBound(myV) > 0 Then
Cells(myR, 2).Resize(UBound(myV) - LBound(myV)).EntireRow.Insert
For i = LBound(myV) To UBound(myV)
Cells(myR, 2).Offset(i, 0).Value = myV(i)
Next i
End If
Next myR

Application.CutCopyMode = False

End Sub

 

[Joel]

try this code

Sub seperate_semicolon()

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
RowCount = 1
Do While Range("A" & RowCount) <> ""
SemiColonStr = Trim(Range("B" & RowCount))
Do While Len(SemiColonStr) > 0
If InStr(SemiColonStr, ";") > 0 Then
Number = Left(SemiColonStr, InStr(SemiColonStr, ";") - 1)
SemiColonStr = Mid(SemiColonStr, InStr(SemiColonStr, ";") + 1)
Rows(RowCount + 1).Insert
Range("B" & RowCount) = Number
Range("A" & RowCount + 1) = Range("A" & RowCount)
Range("C" & RowCount + 1) = Range("C" & RowCount)
RowCount = RowCount + 1
Else
Number = SemiColonStr
Range("B" & RowCount) = Number
SemiColonStr = ""
End If
Loop

RowCount = RowCount + 1
Loop

End Sub