Here, I think this code will work. Choose the cell with the list in it as
"J1-J3,J8..."
and then use Tools | Macros | Macro to [Run] macro named Breakout
Results will be placed starting at row below where the list is at.
If you need helping getting the code into your workbook, see:
http://www.jlathamsite.com/Teach/Excel_GP_Code.htm
A functioning workbook can be uploaded at:
http://www.jlathamsite.com/Uploads/for_tbriggs.xls
The code to do it:
Sub Breakout()
'assumes you have cell with list selected
'when you call this macro AND
'that the ID (121-45) is in column
'immediately to the left of the one you're in
'
Dim RawData As String
Dim NumberOfGroups As Integer
Dim LoopCounter As Integer
Dim NumCounter As Integer
Dim EndSeparatorPosition As Integer
Dim groupSeparator As String ' comma that separates groups as J1,J2,J3
Dim itemSeparator As String ' dash used within ranging group as
J1-J3,J8-J14, etc.
Dim Groups() As String
Dim Pieces() As String
Dim FirstGroup As String
Dim GroupStartNumber As Long ' assumed whole numbers
Dim LastGroup As String
Dim GroupEndNumber As Long ' assumed whole numbers
Dim strTemp As String ' used to find GroupStart/EndNumber values
Dim GroupPrefix As String
Dim BaseInfo As String ' to save the "121-45" type data
Dim RowOffset As Long ' could be lots of them, so...
'will be one space for each group
If IsEmpty(ActiveCell) Then
Exit Sub
End If
RawData = Trim(ActiveCell.Text)
If Len(RawData) = 0 Then
Exit Sub ' do nothing
End If
groupSeparator = "," ' set to whatever unique character you need
itemSeparator = "-" ' again, to whatever unique character is used
'find out how many groups
NumberOfGroups = 1 ' is at least one
If InStr(RawData, groupSeparator) Then
'at least 2, find out how many
For LoopCounter = 1 To Len(RawData)
If Mid(RawData, LoopCounter, 1) = groupSeparator Then
NumberOfGroups = NumberOfGroups + 1
End If
Next
End If
'pull out each of the groups, put them in array
'Groups() to deal with later
ReDim Groups(1 To 1)
If NumberOfGroups = 1 Then
Groups(1) = RawData ' yes, just that easy for just one
Else
'not so easy for multiples
Do Until InStr(RawData, groupSeparator) = 0
Groups(UBound(Groups)) = Left(RawData, _
InStr(RawData, groupSeparator) - 1)
RawData = Right(RawData, Len(RawData) - _
InStr(RawData, groupSeparator))
ReDim Preserve Groups(1 To UBound(Groups) + 1)
Loop
'one loop left over save it also
Groups(UBound(Groups)) = RawData
End If
'works great to this point!
For LoopCounter = 1 To UBound(Groups)
RawData = Groups(LoopCounter)
If InStr(RawData, itemSeparator) = 0 Then
'a one item group
On Error Resume Next
Pieces(UBound(Pieces)) = RawData
If Err <> 0 Then
Err.Clear
ReDim Pieces(1 To 1)
Pieces(1) = RawData
End If
On Error GoTo 0 ' clear trapping
ReDim Preserve Pieces(1 To UBound(Pieces) + 1) ' empty ready for
next
Else
'multiple item group
FirstGroup = Left(RawData, InStr(RawData, itemSeparator) - 1)
LastGroup = Right(RawData, Len(RawData) - _
InStr(RawData, itemSeparator))
'presumes group start is numeric end of the whole thing, as 12
in J4B12
strTemp = ""
For NumCounter = Len(FirstGroup) To 1 Step -1
If Mid(FirstGroup, NumCounter, 1) >= "0" And _
Mid(FirstGroup, NumCounter, 1) <= "9" Then
strTemp = Mid(FirstGroup, NumCounter, 1) & strTemp
Else
'all done in here
Exit For
End If
Next
GroupStartNumber = Val(strTemp)
strTemp = ""
For NumCounter = Len(LastGroup) To 1 Step -1
If Mid(LastGroup, NumCounter, 1) >= "0" _
And Mid(LastGroup, NumCounter, 1) <= "9" Then
strTemp = Mid(LastGroup, NumCounter, 1) & strTemp
Else
'all done in here
Exit For
End If
Next
GroupEndNumber = Val(strTemp)
GroupPrefix = Left(LastGroup, Len(LastGroup) - Len(strTemp))
'start building items and filling/adding to Items() array
For NumCounter = GroupStartNumber To GroupEndNumber
On Error Resume Next
Pieces(UBound(Pieces)) = GroupPrefix & Trim(Str(NumCounter))
If Err <> 0 Then
Err.Clear
ReDim Pieces(1 To 1)
Pieces(UBound(Pieces)) = GroupPrefix &
Trim(Str(NumCounter))
End If
On Error GoTo 0
ReDim Preserve Pieces(1 To UBound(Pieces) + 1) ' empty ready
for next
Next
End If
Next ' LoopCounter
'ready now to spit stuff out to the worksheet
BaseInfo = ActiveCell.Offset(0, -1).Value ' 1 column to left of current
one
'we will put the stuff on sheet starting at row right below original
'so that we can see results and save original for reuse/comparison/testing
RowOffset = 1 ' initialize
For LoopCounter = LBound(Pieces) To UBound(Pieces) - 1
ActiveCell.Offset(RowOffset, -1) = BaseInfo
ActiveCell.Offset(RowOffset, 0) = Pieces(LoopCounter)
RowOffset = RowOffset + 1
Next
End Sub
tbriggs said:
I have a situation where I have data in a single cell such
as:"J1-J3,J8,J10,J12-J15" I need to expand that cell into individual
cells with J1, J2, J3, J8, J10, J12, J13, J14, J15 in them.
We usually get a bill of materials in excel format that will have a
part number and then all the reference designators associated with that
part number. So the part number of all the reference designators might
be 121-45.
The Excel file would have in cell A1, "121-45" and cell B1 would have
"J1-J3,J8,J10,J12-J15".
I would like some way to convert this to:
Before
A B
1 121-45 J1-J3,J8,J10,J12-J15
After
A B
1 121-45 J1
2 121-45 J2
3 121-45 J3
4 121-45 J8
5 121-45 J10
6 121-45 J12
7 121-45 J13
8 121-45 J14
9 121-45 J15
There is a program called BOM explorer that does a function similar to
that. It is used mainly by contract manufacturers.
Any help would be appreciated.
Thanks!
tbriggs
