On Tue, 16 Jul 2013 00:10:40 +0100, gregbowey wrote:


Excellent, Ron! Thanks so much for your help. This has done exactly what
I asked.

Just one thing I am wondering though, once I've used up all of the
letters of the alphabet (let's assume that I have one marble lot that
is, say, 50kg) it starts going through symbols and lower case letters.
Is there a way to get the spreadsheet to go ....X|Y|Z|AA|AB|AC....
rather than going through symbols and lower case letters?

Thanks again. You've just saved me days of work across a whole year!

Glad to help. Thanks for the feedback.

One way of doing sequential all caps lettering would be to use the column labelling method existing in Excel. This limits you to 16,384 lots. If that will be an issue, we'll need to use another scheme, but this one is easy to implement:

==================================
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, lLot As Long
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)
lLot = 0 'column number = "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
lLot = lLot + 1
sLot = Cells(1, lLot).Address(columnabsolute:=False)
sLot = Left(sLot, InStr(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
========================================