On Mon, 15 Jul 2013 01:59:53 +0100, gregbowey wrote:


Hi

I have a spreadsheet of weight values that I want to distribute evenly
into 500g lots. Let's say I'm importing marbles and I have a whole bunch
of varieties that need to be kept separate from each other. See below
for the raw data.

DATE Country Origin Marble Lot Weight (kg)
01/04/2013 AUS 2 MAR001 2.6
01/04/2013 AUS 3 MAR001 1.9
01/04/2013 AUS 3 MAR002 0.7
01/04/2013 AUS 3 MAR003 3.7
01/04/2013 AUS 3 MAR004 2.02
01/04/2013 AUS 4 MAR004 0.24

What I would like to do is have a formulated spreadsheet that picks up
this data and separates it into 500g lots and assigns a sequential
letter of the alphabet to it and also puts out the remainder (the left
overs in a smaller bag that is <500). This last part is less essential
than the overall function of the distribution to the correct number of
500g segments. The ideal output will look like this:

DATE Country Origin Marble Lot Weight (kg)
01/04/2013 AUS 2 MAR001 A 0.5
01/04/2013 AUS 2 MAR001 B 0.5
01/04/2013 AUS 2 MAR001 C 0.5
01/04/2013 AUS 2 MAR001 D 0.5
01/04/2013 AUS 2 MAR001 E 0.5
01/04/2013 AUS 2 MAR001 F 0.1
01/04/2013 AUS 3 MAR001 A 0.5
01/04/2013 AUS 3 MAR001 B 0.5
01/04/2013 AUS 3 MAR001 C 0.5
01/04/2013 AUS 3 MAR001 D 0.4
01/04/2013 AUS 3 MAR002 A 0.5
01/04/2013 AUS 3 MAR002 B 0.2
01/04/2013 AUS 3 MAR003 A 0.5
01/04/2013 AUS 3 MAR003 B 0.5
01/04/2013 AUS 3 MAR003 C 0.5
01/04/2013 AUS 3 MAR003 D 0.5
01/04/2013 AUS 3 MAR003 E 0.5
01/04/2013 AUS 3 MAR003 F 0.5
01/04/2013 AUS 3 MAR003 G 0.5
01/04/2013 AUS 3 MAR003 H 0.2
01/04/2013 AUS 3 MAR004 A 0.5
01/04/2013 AUS 3 MAR004 B 0.5
01/04/2013 AUS 3 MAR004 C 0.5
01/04/2013 AUS 3 MAR004 D 0.5
01/04/2013 AUS 3 MAR004 E 0.02
01/04/2013 AUS 4 MAR004 A 0.24

Apologies for the large dataset but I need these different combinations
to work. Is there anyone out there that knows of a way to do this?

Don't apologize for the data set. Usually most posters don't provide enough.
Your data set and results look as if each line in the raw data will be split separately; in other words, we won't have to combine two or more sets of the same type of Marble.

That being the case, this can be done with a VBA Macro.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN.

=============================================
Option Explicit
Sub Marbles()
Dim rDest As Range
Dim v As Variant, vRes As Variant
Dim s As String
Dim i As Long, j As Long, k As Long, L As Long, M As Long
Dim lResRowCount As Long
Dim d As Double
Dim sLot As String
Const dLotSize As Double = 0.5

'The following constants (column numbers) could be
' determined by this macro if they might vary
Const colCount As Long = 6
Const colOrigin As Long = 3
Const colMarble As Long = 4
Const colWeight As Long = 6

'put results "next to" original data
'could easily put on a new worksheet or elsewhere
' or even replace the original if not needed
Set rDest = Range("a1").Offset(columnoffset:=colCount + 1)

'read original data into an array for faster processing
v = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=colCount)

'determine dimension of results array
For i = 1 To UBound(v)
d = v(i, colWeight)
j = Int(d / dLotSize)
If (j * dLotSize) < d Then j = j + 1
lResRowCount = lResRowCount + j
Next i

'populate Results Array
k = 1
ReDim vRes(1 To lResRowCount, 1 To colCount)
For i = 1 To UBound(v, 1)
sLot = Chr(64) 'Code for "A" -1
M = k
For j = 1 To colCount
d = v(i, colWeight)
L = Int(d / dLotSize)
If (L * dLotSize) < d Then L = L + 1
For k = M To M + L - 1
Select Case j
Case 1 To 4
vRes(k, j) = v(i, j)
Case 5
sLot = Chr(Asc(sLot) + 1)
vRes(k, j) = sLot
Case 6
If d dLotSize Then
vRes(k, j) = dLotSize
Else
vRes(k, j) = d
End If
d = d - dLotSize
End Select
Next k
Next j
Next i

'copy Labels
Range("A1").Resize(columnsize:=colCount).Copy Destination:=rDest


Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2)).Offset(rowoffset:=1)
Range(rDest, Cells(Rows.Count, rDest.Column)).Clear

rDest = vRes

End Sub
================================================== ===