Separating data with VBA

Hey guys!

I´ve gotten alot of help on this forum before, and now I have come to yet another issue with a Excel function that I can´t seem to solve.

I´m making a cutting list for work, and I want the list to separate the data a bit more.

I´ll explain.

Amount	Length	Type 1	Cutting Info	Type 2	Label
2	2180,0	M3TR-1201	1 BRY-V:1741 / UB-V:119	372847	[1]-7 [1]-14
2	2080,0	M3TR-1201		372847	[1]-6 [1]-15
10	1980,0	M3TR-1201	1 BRY-V:1741 / UB-V:119	372847	[5]-6 [3]-7 [2]-9
110	1980,0	M3TR-1201		372847	[10]-1 [10]-2 [10]-3 [10]-4 [10]-5 [10]-6 [10]-7 [10]-8 [10]-9 [10]-10 [10}-11
20	1950,0	M3TR-1201		372847	[5]-4 [5]-5 [10]-6

Amount if the total amount of pieces of that length and type.
Length if the lenght of the piece that´s gonna be cut.
Type 1 is the drawing number that the piece is going to be cut after.
Cutting info is the measurements for cutting
Type 2 is another drawing number


And then we have Label. Here is my problem.

The number inside of the [] is an amount.
If we take the first row as an example.

[1]-7 [1]-14 That means that 1 piece is being labeled with "7" and 1 piece is being labeled with "14" As you can see on the fourth row there can be alot of [] on the same line. I would think that the maximum I´ve ever seen is around 25 different labels on the same row. What I want my Excel to be able to do is to take that list up there and change it to this: Amount Length Type 1 Cutting Info Type 2 Label 1 2080,0 M3TR-1201 1 BRY-V:1741 / UB-V:119 372847 [1]-7 1 2080,0 M3TR-1201 1 BRY-V:1741 / UB-V:119 372847 [1]-14 1 1980,0 M3TR-1201 372847 [1]-6 1 1980,0 M3TR-1201 372847 [1]-15 5 1980,0 M3TR-1201 1 BRY-V:1741 / UB-V:119 372847 [5]-6 3 1980,0 M3TR-1201 1 BRY-V:1741 / UB-V:119 372847 [3]-7 2 1980,0 M3TR-1201 1 BRY-V:1741 / UB-V:119 372847 [2]-9 10 1980,0 M3TR-1201 372847 [10]-1 10 1980,0 M3TR-1201 372847 [10]-2 10 1980,0 M3TR-1201 372847 [10]-3 10 1980,0 M3TR-1201 372847 [10]-4 10 1980,0 M3TR-1201 372847 [10]-5 10 1980,0 M3TR-1201 372847 [10]-6 10 1980,0 M3TR-1201 372847 [10]-7 10 1980,0 M3TR-1201 372847 [10]-8 10 1980,0 M3TR-1201 372847 [10]-9 10 1980,0 M3TR-1201 372847 [10]-10 10 1980,0 M3TR-1201 372847 [10]-11 5 1980,0 M3TR-1201 372847 [5]-4 5 1980,0 M3TR-1201 372847 [5]-5 10 1980,0 M3TR-1201 372847 [10]-6

I need it to separate the labels into a row each.
Is this doable?
Can someone help me with this?
Would be greatly appreciated.
Attachment 17261

I´ve attached a excel file with the data above in it.

It's late, so I am only going to outline the procedure.

Hmmmmm. . . For easier numbering, lets set the Array low index = 1 vs zero
Option Base 1 (at the top of the code page)

When inserting or deleting Rows, always start at the bottom.
So. . . For r = Cells(Rows.Count, "A").End(xlUp).Row to 2 Step -1

A Couple of Constants would be handy
Const AmtCol As Long = 1
Const LblCol As Long = 6

We need to split the labels and count them. For that an Array is perfect
Dim Labels As Variant
Dim LabelsCount As Long


Labels = Split(Cells(r, LblCol), "[")
LabelsCount = UBound(Labels)
NewAmt = Cells(r, AmtCol) / LabelsCount


OK, now copy and insert LabelsCount - 1 times

Cells(r, amtCol).Resize(, 6).Copy
For loop to insert goes here


Edit the Amounts
Cells(r, AmtCol).Resize(LablesCount, 1).Value = NewAmt


The new Labels need an addition step to add the now missing (due to Split) Leading Bracket
For i = 1 to LabelsCount
Labels(i) = "[" & Labels(i)
Next i


and place them as needed
Cells(r, LblCol).Resize(0, LabelsCount).Value = Labels


Rinse and Repeat with
Next r


Hope this helps.

Good Night.

This is all you need:

Code:

---

Sub M_snb()
  sn = Cells(3, 1).CurrentRegion
 
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      st = Split(sn(j, UBound(sn, 2)), "[")
      For jj = 1 To UBound(st)
        .Item("P_" & .Count) = Array(Val(st(jj)), sn(j, 2), sn(j, 3), sn(j, 4), sn(j, 5), "[" & st(jj))
      Next
    Next
   
    Cells(40, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
  End With
End Sub

---

More on dictionaries:

http://www.snb-vba.eu/VBA_Dictionary_en.html

snb

That does exactly what I need, but I don´t understand anything of that code. Where can I change where the output goes? Can I have the output in a brand new sheet? The example I gave was only 5 rows. can I use that on lets say 500 rows?

I found where I can change the Output. But when I´m trying it now I get a "Incompatible Types" error message, and when I press the Troubleshoot button it highlight this row:

Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)

post your workbook.

in another worksheet:

Code:

---

Sub M_snb()
    sn = activeworksheet.Cells(3, 1).CurrentRegion
   
    With CreateObject("scripting.dictionary")
        For j = 2 To UBound(sn)
            st = Split(sn(j, UBound(sn, 2)), "[")
            For jj = 1 To UBound(st)
                .Item("P_" & .Count) = Array(Val(st(jj)), sn(j, 2), sn(j, 3), sn(j, 4), sn(j, 5), "[" & st(jj))
            Next
        Next
       
        Sheet2.Cells(1, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    End With
End Sub

---

Quote:

---

can I use that on lets say 500 rows?

---

You can use it on every Row in the Sheet.

I study all snb's offerings, and sometimes post what I think his code is doing in the hopes that he will correct me when I am wrong.

Although all variables in his code are actually Typed as Variants, this is their use.

Code:

---

Dim sn As Variant 'for an Array
Dim j as long 'The Array index, effectively a Row Index or counter
Dim st as Variant ' The Split Labels Array
Dim jj as Long 'Array index, effectively the Label Index or counter

---

sn = Range.CurrentRegion: Put that Area into the array

st = Split(sn(j, UBound(sn, 2)), "["): see my first post in re splitting the labels. UBound(sn, 2) is the last "Column" number.

.Item("P_" & .Count): .Item belongs to the Dictionary and "P_" & .Count is the Inderx. .Count also belongs to the Dictionary and increments by 1 each time .Item adds a new Item

Val(st(jj)): Remember the labels lost the leading bracket when Split, so they look like 1]-7. Val returns the numbers up to the "]"

For jj = 1 To UBound(st): Adds a new Item for each Label where each Item will be a Row in the new sheet.

sn(j, 2), sn(j, 3), sn(j, 4), sn(j, 5): j is the existing Row number and 2, 3, 4, and 5 are the existing column numbers respective to the .CurrentRegion.

Application.Index(.Items, 0, 0) = put the Dictionary's contents on the sheet

I have a more wordy style, all variables Dim-ed and given names so I can remember what they do, comments added so I see my logic, .....

The raw data was is on Input and the results are on Output

Code:

---

Option Explicit

Sub SplitData()
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim rData As Range, rRow As Range
    Dim vRow As Variant
    Dim iOut As Long, iSplit As Long, iMatch As Long
   
    Application.ScreenUpdating = False
       
    Set wsIn = Worksheets("Input")
   
    'delete existing Output
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Output").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    'add new sheet
    Worksheets.Add.Name = "Output"
    Set wsOut = Worksheets("Output")
     
    'set just the input data rows
    Set rData = wsIn.Cells(1, 1).CurrentRegion
    rData.Rows(1).Copy wsOut.Cells(1, 1)
    With rData
        Set rData = .Cells(2, 1).Resize(.Rows.Count - 1, .Columns.Count)
    End With

    iOut = 2

    With wsOut
        For Each rRow In rData.Rows
           
            vRow = Split(rRow.Cells(1, 6).Value, " ")
           
            For iSplit = LBound(vRow) To UBound(vRow)
               
                iMatch = InStr(vRow(iSplit), "]")
                .Cells(iOut, 1).Value = Mid(vRow(iSplit), 2, iMatch - 2)
                .Cells(iOut, 2).Value = rRow.Cells(1, 2).Value
                .Cells(iOut, 3).Value = rRow.Cells(1, 3).Value
                .Cells(iOut, 4).Value = rRow.Cells(1, 4).Value
                .Cells(iOut, 5).Value = rRow.Cells(1, 5).Value
                .Cells(iOut, 6).Value = vRow(iSplit)
                   
                iOut = iOut + 1
            Next iSplit
        Next
    End With

    wsOut.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

    Application.ScreenUpdating = True
End Sub

---

or

Code:

---

Sub M_snb()
  sn = Sheet1.Cells(3, 1).CurrentRegion
 
  For j = 2 To UBound(sn)
    st = Split(sn(j, UBound(sn, 2)), "[")
    For jj = 1 To UBound(st)
      c00 = c00 & "|" & Val(st(jj)) & "_" & sn(j, 2) & "_" & sn(j, 3) & "_" & sn(j, 4) & "_[" & st(jj)
    Next
  Next
  sp = Split(Mid(c00, 2), "|")
 
  Cells(40, 1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
  Cells(40, 1).CurrentRegion.TextToColumns , 1, , 0, 0, 0, 0, 0, True, "_"
End Sub

---

As long as you do everything in memory (my 2 proposals do) the code will be very fast.