Intricate Cell Formatting Question
 

Hello all,

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

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

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

What I seek to do is to find which parts contain "," (which means that the base part has multiple configurations), and split this base part to let each configuration have their own row (to insert new rows beneath), and copy the information from the original contained in adjacent 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 a simple ISNUMBER, but there are over 1000 different base parts, each with several different configurations.

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

Sincerely,
MR

Intricate Cell Formatting Question
 

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