Excel Button for an order guide

Mrupe86

New Member
Joined
Jun 22, 2024
Messages
8
Office Version
  1. 365
Platform
  1. Windows
I am struggling with my excel spreadsheet. I take a weekly inventory of items and subtract it from a needs list to create orders for the week. My coworker does it manually, but I decided to assist by making buttons for him to do various tasks. I can't seem to get this one button accomplished.

Difference between If G-F (is positive) / spread the number needed into the four columns. If G-F (is negative) then 0.

I can move columns around if needed and make adjustments in my current macros. Any help is appreciated!
Screenshot 2024-07-20 123202.png


I tried a few SpreadEven VBA codes I found online. I was unable to make the needed adjustments to make it work.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I'm supposed to be outside and finishing my deck stain job, so I can only take time to suggest an approach in general terms. If G - F > 0 then ...
Counting only rows with data, consider row 1
8-4=4; get the modulus of 4 (because there seems to be only 4 days of concern):
4 Mod 4 = 0 so divide 4 by 4 (=1) so put 1 in each cell.

Consider row 4; 15 - 5 = 10
10 Mod 4 = 2 so put 2 in one cell; subtract that 2 and repeat. However, you have used up one day so the modulus will be based on 3.
8 Mod 3 = 2 so put 2 in another cell; subtract as before (2) and repeat but now only 2 days remain
6 Mod 2 = 0 Now go back to the original logic - divide the remainder (6) into the remaining 2 cells, so 3 and 3

If you want the order of values like you showed in your post, then insert from right to left instead of left to right. You'd have to play with that to see what happens with other G - F values because 2 examples is not much to go on.
Gotta run.
 
Upvote 0
I'm supposed to be outside and finishing my deck stain job, so I can only take time to suggest an approach in general terms. If G - F > 0 then ...
Counting only rows with data, consider row 1
8-4=4; get the modulus of 4 (because there seems to be only 4 days of concern):
4 Mod 4 = 0 so divide 4 by 4 (=1) so put 1 in each cell.

Consider row 4; 15 - 5 = 10
10 Mod 4 = 2 so put 2 in one cell; subtract that 2 and repeat. However, you have used up one day so the modulus will be based on 3.
8 Mod 3 = 2 so put 2 in another cell; subtract as before (2) and repeat but now only 2 days remain
6 Mod 2 = 0 Now go back to the original logic - divide the remainder (6) into the remaining 2 cells, so 3 and 3

If you want the order of values like you showed in your post, then insert from right to left instead of left to right. You'd have to play with that to see what happens with other G - F values because 2 examples is not much to go on.
Gotta run.
Thank you, Micron for the feedback. I do need a VBA code to attach to a button. The macro would have to leave an integer in the cell, and not a formula. The other buttons create a CSV file that is uploaded online as an order.
 
Upvote 0
My suggestion was to code all that, not use formulas. Since you already have code, I presumed what you needed was a method that could work for you, and maybe you were the one going to write that. Not sure I would have the time for at least a few days - it's a big deck!
 
Upvote 0
Took some time for this (actually, a lot). Close but no cigar - needs some tweaking but it may give you some insights, such as G value not being less than F. Is that a post error, or is it reality? (EDIT - I see now that the values should have been zero. Easier to leave blanks if that's OK).

Getting late, so done for the night. I don't know why 7 - 1 (row 6) produced that result. Maybe it gives you hope that it could be worked out. You said you had code - I should have asked to see it for guidance.
VBA Code:
Sub Disbursements()
Dim rng As Range
Dim lrow As Long, lngDiff As Long, i As Long, x As Long, n As Integer

lrow = Cells(rows.count, "F").End(xlUp).Row

For Each rng In Range("F4:F" & lrow)
    lngDiff = rng.Offset(0, 1) - rng
    Select Case True
        Case lngDiff > 0 And lngDiff < 5
            For i = 1 To lngDiff
                rng.Offset(0, i + 1) = 1
            Next
        Case Else
            n = 4
            Do Until lngDiff Mod n = 0
                x = lngDiff Mod n
                i = i + 1
                rng.Offset(0, i + 1) = x
                lngDiff = lngDiff - x
                n = n - 1
            Loop
            x = lngDiff / 2
            If x > 0 Then
                Do Until i = 4
                    i = i + 1
                    rng.Offset(0, i + 1) = x
                Loop
            End If
    End Select
    i = 0
Next

End Sub

Results
FGHIJK
4​
4​
4​
4​
4​
4​
5​
15​
2​
2​
3​
3​
5​
3​
-2​
1​
3​
1​
1​
1​
7​
2​
1​
1​
1​
1​
2​
1​
1​
2​
1​
1​
3​
1​
1​
1​
2​
1​
1​
10​
1​
2​
3​
3​
1​
3​
1​
1​
1​
2​
1​
1​
4​
1​
1​
1​
1​
2​
1​
1​
2​
1​
 
Upvote 0
After a good sleep, I think that the Select Case block could handle all the variations. It will certainly make the code longer though. Working on it when I can.
However, I'm wondering if the splitting of the deliveries is important. For six you show 2,1,1,2. Would 2,2,1,1 be ok? If not I think my approach isn't going to work. It also begs the question of other numbers such as 10. Then what? 3,3,3,1 or 3,3,1,3 or 3,1,3,3?
 
Last edited:
Upvote 0
Took some time for this (actually, a lot). Close but no cigar - needs some tweaking but it may give you some insights, such as G value not being less than F. Is that a post error, or is it reality? (EDIT - I see now that the values should have been zero. Easier to leave blanks if that's OK).

Getting late, so done for the night. I don't know why 7 - 1 (row 6) produced that result. Maybe it gives you hope that it could be worked out. You said you had code - I should have asked to see it for guidance.
VBA Code:
Sub Disbursements()
Dim rng As Range
Dim lrow As Long, lngDiff As Long, i As Long, x As Long, n As Integer

lrow = Cells(rows.count, "F").End(xlUp).Row

For Each rng In Range("F4:F" & lrow)
    lngDiff = rng.Offset(0, 1) - rng
    Select Case True
        Case lngDiff > 0 And lngDiff < 5
            For i = 1 To lngDiff
                rng.Offset(0, i + 1) = 1
            Next
        Case Else
            n = 4
            Do Until lngDiff Mod n = 0
                x = lngDiff Mod n
                i = i + 1
                rng.Offset(0, i + 1) = x
                lngDiff = lngDiff - x
                n = n - 1
            Loop
            x = lngDiff / 2
            If x > 0 Then
                Do Until i = 4
                    i = i + 1
                    rng.Offset(0, i + 1) = x
                Loop
            End If
    End Select
    i = 0
Next

End Sub

Results
FGHIJK
4​
4​
4​
4​
4​
4​
5​
15​
2​
2​
3​
3​
5​
3​
-2​
1​
3​
1​
1​
1​
7​
2​
1​
1​
1​
1​
2​
1​
1​
2​
1​
1​
3​
1​
1​
1​
2​
1​
1​
10​
1​
2​
3​
3​
1​
3​
1​
1​
1​
2​
1​
1​
4​
1​
1​
1​
1​
2​
1​
1​
2​
1​
Thank you Macron! I like the code, but I was unable to work out the kinks. This left some negative numbers in H and all the small disbursements in H as well! I have decided to get with the following! It spread the numbers evenly(ish). Its a little hacky, but I am an amateur coder at best. The formula was provided by another user on StackOverflow.
VBA Code:
Sub Distribute()
Range("H6").Formula2 = "= IF(($F6-$G6)>0,ROUND(($F6-$G6)/4,),""0"")"
Range("I6:K6").Formula2 = "= IF(($F6-$G6)>0,ROUND(($F6-$G6-SUM($H6:H6))/(COLUMN($I6)+2-COLUMN(H6)),),""0"")"
   With ActiveSheet
Range("H6").AutoFill Destination:=Range("H6:H" & Range("H" & Rows.Count).End(xlUp).Row)
Range("I6").AutoFill Destination:=Range("I6:I" & Range("I" & Rows.Count).End(xlUp).Row)
Range("J6").AutoFill Destination:=Range("J6:J" & Range("J" & Rows.Count).End(xlUp).Row)
Range("K6").AutoFill Destination:=Range("K6:K" & Range("K" & Rows.Count).End(xlUp).Row)
    End With
    Dim ws As Worksheet, rng As Range

    For Each ws In ActiveWorkbook.Worksheets

        For Each rng In ws.UsedRange

            If rng.HasFormula Then

                rng.Formula = rng.Value

            End If

        Next rng

    Next ws

End Sub
 
Last edited by a moderator:
Upvote 0
After a good sleep, I think that the Select Case block could handle all the variations. It will certainly make the code longer though. Working on it when I can.
I am happy to see that I am not the only one up at night thinking about how to code VBA more effectively! Thank you again for the time you spent on this :)
 
Upvote 0
I was editing my post during your post. You can ignore the questions I added if you have a solution. It seems you are saying that but I'm not sure. If so, you should mark your last post as the solution.

Please post code within code tags (use vba button on posting toolbar) to maintain indentation and readability.
 
Upvote 0
Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Excel Button for a par sheet
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Forum statistics

Threads
1,224,808
Messages
6,181,072
Members
453,020
Latest member
mattg2448

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top