I need some help with Arrays

[mikebres]

I'm trying to get the data from this format:
MNO Sort ZONES IN SORT PROGRAM
23 80011 80011, 80042
47 80012 80012, 80041
53 80013 80013
33 80014 80014, 80044

To this Format:
MNO Sort ZONES IN SORT PROGRAM
23 80011 80011
23 80011 80042
47 80012 80012
47 80012 80041
53 80013 80013
33 80014 80014
33 80014 80044

So that each of the comma delimeted items in the last column is split out to
it's own row, with the MNO and the Sort listed for each of the split items.

Any ideas?

Thanks
Mike

 

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim ary As Variant
Dim NumRows As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 2 Step -1

ary = Split(.Cells(i, "C"), ",")
If UBound(ary) > LBound(ary) Then

NumRows = UBound(ary) - LBound(ary)
.Rows(i + 1).Resize(NumRows).Insert
.Cells(i + 1, "A").Resize(NumRows) = Cells(i, "A").Value
.Cells(i + 1, "B").Resize(NumRows) = Cells(i, "B").Value
.Cells(i, "C").Resize(NumRows + 1) =
Application.transpose(ary)
End If
Next i

End With

End Sub

 

[mikebres]

Thank you. I went a slightly different direction, but you gave me the nudge
I needed.

Sub SplitList2()
Dim strArray() As Variant, strItem() As String
Dim SelCnt As Long

ReDim strArray(SelCnt)

strArray = Selection.value

SelCnt = UBound(strArray, 1)
If SelCnt < 1 Then GoTo SL2_End

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.count)
Range("$A$1").Activate

'Assume the first row is labels and print them
For i = 1 To UBound(strArray, 2)
ActiveCell.Offset(0, i - 1).value = strArray(1, i)
Next i

ActiveCell.Offset(1, 0).Activate

For i = 2 To SelCnt
strItem = Split(strArray(i, 3), ",")
'Because Split uses a zero based array I needed to add 1 to the count
NumRows = UBound(strItem) + 1
ActiveCell.Resize(NumRows) = strArray(i, 1)
ActiveCell.Offset(0, 1).Resize(NumRows) = strArray(i, 2)
ActiveCell.Offset(0, 2).Resize(NumRows) = Application.Transpose(strItem)
ActiveCell.Offset(NumRows, 0).Activate
Next i

SL2_End:

End Sub


Mike