Intricate Cell Formatting Question

[pynergee]

Hello all,

I am working with a worksheet that contains thousands of different par
numbers, some of them containing different configurations.

Ex. Part Number: 1-1500-10,11,15 (This is the format these parts number
are currently in).

This means that there are three different parts in that one cell, part
1-1500-10, 1-1500-11 and 1-1500-15.

What I seek to do is to find which parts contain "," (which means tha
the base part has multiple configurations), and split this base part t
let each configuration have their own row (to insert new rows beneath)
and copy the information from the original contained in adjacen
columns.

Ex. The part number 1-1500-10, 11, 15 would go to:
1-1500-10 ...... Same information from base part.......
1-1500-11 ...... Same information from base part.......
1-1500-15 ...... Same information from base part.......

I have already determined which ones have multiple configurations with
simple ISNUMBER, but there are over 1000 different base parts, each wit
several different configurations.

If anyone has some good ideas for VBA or anything easy to do this, i
would save me quite a bit of time.

Sincerely,
M

 

[GS]

Try...

Sub ParsePartNums()
Dim vDataIn, vNum, vConfigs, vTemp$(), v
Dim n&, i&, k&, j&, x&, lRows&, lCols&

With ActiveSheet
lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
vDataIn = ActiveSheet.Range(Cells(1, 1), Cells(lRows, lCols))
ReDim vTemp(0)

'Parse the data
For n = LBound(vDataIn) To UBound(vDataIn)
If InStr(1, vDataIn(n, 1), ",") > 0 Then
vNum = Split(vDataIn(n, 1), "-"): vConfigs = Split(vNum(2), ",")
'Get current num elements and reset counter
j = UBound(vTemp) + 1: x = 0
ReDim Preserve vTemp(UBound(vTemp) + UBound(vConfigs) + 1)
For k = j To UBound(vTemp)
vTemp(k) = Join(Array(vNum(0), vNum(1), vConfigs(x)), "-")
For i = 2 To UBound(vDataIn, 2)
vTemp(k) = Join(Array(vTemp(k), vDataIn(n, i)))
Next 'i
x = x + 1
Next 'k
Else
ReDim Preserve vTemp(UBound(vTemp) + 1)
vTemp(UBound(vTemp)) = vDataIn(n, 1)
For i = 2 To UBound(vDataIn, 2)
vTemp(UBound(vTemp)) = _
Join(Array(vTemp(UBound(vTemp)), vDataIn(n, i)))
Next 'i
End If
Next 'n

'Bypass limitations of WorksheetFunction.Transpose
ReDim vDataOut(1 To UBound(vTemp), 1 To lCols)
For n = 1 To UBound(vTemp)
v = Split(vTemp(n))
For j = 0 To UBound(v)
vDataOut(n, j + 1) = v(j)
Next 'j
Next 'n

'Dump the data into the worksheet
Range("A1").Resize(UBound(vDataOut), lCols) = vDataOut
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion