PDA

View Full Version : Separating data with VBA



Robert87
10-04-2016, 09:01 PM
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.
17261

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

SamT
10-04-2016, 09:59 PM
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.

snb
10-05-2016, 01:12 AM
This is all you need:


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

Robert87
10-05-2016, 01:25 AM
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?

Robert87
10-05-2016, 02:17 AM
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)

snb
10-05-2016, 02:44 AM
post your workbook.

in another worksheet:


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

SamT
10-05-2016, 06:42 AM
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.

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

Paul_Hossler
10-05-2016, 07:36 AM
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





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

snb
10-05-2016, 09:45 AM
or


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.