Insert line where value in colume M exceeds value in column AC and some

[HelpExcelForum]

Hello Excel Forum,

I have a spreadsheet with multiple columns. Column M states the number of boxes required to be despatched per that product. Column AC states the maximum boxes that can be stacked on a pallet. I am unsuccessfully trying to create code that do the following;

If value in column M exceeds value in column AC amend the value in column M to the value in column AC and then create a duplicate line below for the remaining boxes.

Repeat process until column M value less than or equal to column AC value. Loop through all part codes.

As an example...

Original file...
Line No. Column B Column M Column AC
Part Boxes Ordered Max Pallet Qty

1 ABC123 22 8


File post VBA...
Line No. Column B Column M Column AC
Part Boxes Ordered Max Pallet Qty

1 ABC123 8 8
2 ABC123 8 8
3 ABC123 6 8


Hopefully my ramblings above make sense, any help would be massively appreciated!

Carl

[Olly]

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

[HelpExcelForum]

Hi Olly,

I have tried to upload a file 82.5KB and get the following error message;

407 [IOErrorEvent type = "ioError" bubbles=false cancelable=false eventPhase=2 text="Error#2038"]

Any ideas?

Thank you

Carl

[JBeaucaire]

If you're using Internet Explorer, try turning on Compatibility View.
If that doesn't work, an alternate browser maybe?

[JOHN H. DAVIS]

Does this help?

Sub HelpExcelForum()
Dim i As Long
Dim x As Long
For i = Range("M" & Rows.Count).End(3).Row To 2 Step -1
    If Cells(i, "M") > Cells(i, "AC") Then
        x = Cells(i, "M") - Cells(i, "AC")
        Rows(i + 1).Insert
        Rows(i + 1).Value = Rows(i).Value
        Cells(i + 1, "M") = x
    End If
Next i
End Sub

[MickG]

Try this:-

Sub MG27Oct23
Dim Lst             As Long
Dim n               As Long
Dim Rng             As Range
Dim Num             As Long
Lst = Range("B" & Rows.Count).End(xlUp).Row
For n = Lst To 2 Step -1
    With Range("M" & n)
        If (Int(.Value / .Offset(, 16))) > 0 And Not .Value = .Offset(, 16).Value Then
           Num = .Value Mod .Offset(, 16).Value
            .EntireRow.Copy
            If Num = 0 Then
                Range("A" & n).Resize(Int(.Value / .Offset(, 16)) - 1).Insert
                Range("M" & n).Resize(Int(.Value / .Offset(, 16))) = .Offset(, 16).Value
            Else
                Range("A" & n).Resize(Int(.Value / .Offset(, 16))).Insert
                Range("M" & n).Resize(Int(.Value / .Offset(, 16)) + 1) = .Offset(, 16).Value
                Range("M" & n) = Num
            End If
        End If
    End With
Next n
End Sub

Regards Mick

[HelpExcelForum]

John H. Davis, MickG you guys are heroes! Thank you so much, i'm in awe!

[JOHN H. DAVIS]

You're welcome. Glad to help out and thanks for the feedback.

[JBeaucaire]

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.