Parsing data into seperate sheets

[BerkshireGuy]

I have many rows with a cell that looks like this:

2134;2345;2342
2123;2343
2322

So each of these cells can containe one or more numbers seperated by a
semicolon.

I need to parse these numbers out and place them in a seperate
worksheet, preferable in one column so that I can easily do a count of
unqiue values.

How can I do this via code. I rather not having the user needing to use
the Text to columns option..

Thanks
B

 

[Bernie Deitrick]

B,

Insert a new, blank worksheet named ParsedValues into your workbook, then
run this macro with a single cell in the column of data selected

Sub SplitOutValues()
Dim myCell As Range
Dim myR As Range
Set myR = Intersect(ActiveCell.EntireColumn, ActiveSheet.UsedRange)
Dim myV As Variant
Dim i As Integer

Worksheets("ParsedValues").Range("A1").Value = "Parsed values"
For Each myCell In myR
myV = Split(myCell.Value, ";")
For i = LBound(myV) To UBound(myV)
Worksheets("ParsedValues").Range("A65536").End(xlUp)(2).Value = myV(i)
Next i
Next myCell
End Sub

HTH,
Bernie
MS Excel MVP

 

[Guest]

Hi,

This little macro should do the job.

Copy the sheet first.

Option Explicit

Sub parseit()
' tests the current row region
' where the cell pointer is

Const cSep As String = ";"

Dim lRowLast As Long, _
lRowFirst As Long, _
lRow As Long, _
lRowInsert As Long, _
lCol As Long, _
lRowOffset As Long, _
sCell As String, _
iPtr As Integer

lRowFirst = ActiveCell.CurrentRegion.Row
lRowLast = lRowFirst + ActiveCell.CurrentRegion.Rows.Count - 1
lCol = ActiveCell.CurrentRegion.Column

For lRow = lRowLast To lRowFirst Step -1
sCell = Cells(lRow, lCol)
lRowInsert = lRow
Do
iPtr = InStr(1, sCell, cSep)
If iPtr > 0 Then
lRowInsert = lRowInsert + 1
Rows(lRowInsert).Insert
Cells(lRowInsert, lCol) = Left(sCell, iPtr - 1)
sCell = Mid(sCell, iPtr + 1, Len(sCell))
End If
Loop Until iPtr = 0
Cells(lRow, lCol) = sCell
Next lRow

End Sub