Divide value based on reference

Question

I get a file showing references and pallet & weight in a row.

For WMS purposes I need one line per pallet with weight per pallet.

I managed to get the rows to duplicate and set to one based on number of pallets (if it's more than one pallet), but don't know how to afterwards divide based on the reference number.

Sub Palletsplit()
    Dim r As Long, lpallets As Long, lPieces As Long
    Dim strSplit As String
    
    r = 2

    Do Until Range("A" & r).Value = ""
        
        lpallets = Range("A" & r).Value
                
        If lpallets > 1 Then
            
            Application.Goto Rows(r)
                                    
            Rows(r).Copy
            Rows(r + 1).Resize(lpallets - 1).Insert
            Range("A" & r).Resize(lpallets).Value = 1
                               
            Application.CutCopyMode = False
            
        End If
        r = r + 1
    Loop
    
    MsgBox "Pallet split complete."
    
End Sub

For example:
Row A = reference, B = Pallets, C = weight

If I have two references of two and four pallets, my original file looks like:

A    B      C
Ref Pallet Weight
AA   2     40
BB   4     60

With above code, this would result in:

A    B      C
Ref Pallet Weight
AA   1     40
AA   1     40
BB   1     60
BB   1     60
BB   1     60
BB   1     60

The required result is weight per pallet (weight divided by original value per reference):

A    B      C
Ref Pallet Weight
AA   1     20 (original value was 2 pallets of 40 kg, meaning 1 pallet is 40/2=20 kg)
AA   1     20
BB   1     15 (original value was 4 pallets of 60 kg, meaning 1 pallet is 60/4=15 kg)
BB   1     15
BB   1     15
BB   1     15

I can't think of a solution in a loop.

score 1 · Accepted Answer · answered May 13 '20 at 11:29

Store the weight (Dim dWeight As Double), divide it by lpallets, and then put the value in - just like when you replace the number of Pallets with 1

Sub Palletsplit()
    Dim r As Long, lpallets As Long, lPieces As Long, dWeight AS Double
        Dim strSplit As String

    r = 2
    Do Until Range("A" & r).Value = ""

        lpallets = Range("A" & r).Value 'Value in Column A
        dWeight  = Range("B" & r).Value 'Value in Column B

        If lpallets > 1 Then

            Application.Goto Rows(r)

            Rows(r).Copy
            Rows(r + 1).Resize(lpallets - 1).Insert
            Range("A" & r).Resize(lpallets).Value = 1 'New value in Column A
            Range("B" & r).Resize(lpallets).Value = dWeight / lpallets 'New value in Column B

            Application.CutCopyMode = False

        End If
        r = r + 1
    Loop

    MsgBox "Pallet split complete."

End Sub

(I would recommend fully-qualifying your ranged - e.g. Sheet1.Range("A" & r).Value instead of just Range("A" & r).Value, in case the sheet you want to edit is not the ActiveSheet. How to avoid using Select in Excel VBA is always worth reading too)

Works like a charm, thanks! Also thanks for the additional info regarding avoiding select and defining the worksheet! — Bart, May 13 '20 at 12:12

Divide value based on reference

1 Answers1