Userform spinbutton equalize multiple textboxes

[Stephenosn]

Hello all and thank you for looking.

I have a userform that is intended to allow the user to apply job overages into other jobs that are not over budget.

I have an Excel userform with five text boxes that are populated as follows. The user selects a single entry in a listbox (lbxOne) that has a job over budget and an amount, lets say for example $200 (this of course will vary). They then make selections from another listbox (lbxTwo) that is a multi select listbox for jobs under budget. Excel counts the number of selections from the lbxTwo and divides the amount from lbxOne... If there are three selections in lbxtwo there will be three corresponding textboxes with the value of $66.67.

I would like to have spinbuttons beside each of these textboxes that allow the user to adjust their values. Here is my problem. I do not want the value for any of the textboxes to exceed the selected value from lbxOne. I would need all textboxes to adjust accordingly to keep the overall value correct. If one textbox's value is increased/decreased the other textboxes would be adjusted proportionately. There would be a spinbox for each textbox to make it easy on the user.

Does anyone have a solution to coordinate multiple spinboxes,textboxes and a chosen value?

Thank you for having a look,

John

 

[pbornemeier]

Is lbxOne a two-column listbox? Or is the Job Name and Job Over-Budget amount concatenated?
Is lbxTwo a two-column listbox? Showing Name and under-budget amount or does it just list the Job Name?
I assume each of the under budget jobs may be under budget by different amounts, so that may be important in your effort here.

If the user selects 6 items in lbxTwo does the form create 6 new textboxes? Is there a limit to the number that can be selected?

So assume 3 text boxes with 66.66 in 2 of them and 66.67 in one. I spin the first up to 80.00 and the other 2 drop down to 60.00 each. I now spin one of the 60.00 ones up to 100.00. (Delta is 40.00) Should the other 2 drop down to 60.00 and 40.00? (20.00 each) or should 80/140 of the 40.00 delta (22.86) be removed from the 80.00 to bring it to 57.14 and 60/140 of the 40.00 delta (17.14) be removed from the 60.00 to bring it to 42.86. I would call the first method linear and second proportional. Either process will be frustrating for the user although I believe the linear one will be less so. Perhaps a button should be included for each text box to lock in a selected amount and let the other spin buttons affect the unlocked text boxes.

 

[Stephenosn]

Phil,

Thank you for the reply.

lbxOne is a twelve-column listbox with a column for the job name and a column for the amount that it is over budget. lbxTwo is a fourteen-column listbox with a column for the job name and one for budget remaining. I'm trying to find a way to write code to limit both of them to only show non-negative numbers as these would not be of interest to the user, but that's another topic.

Here is my code for UserForm_Initialize()

With lbxTwo
    .ColumnCount = 12
    .ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;50"
    .ColumnHeads = True
    .RowSource = "=Report!B9:M18"
    .MultiSelect = fmMultiSelectMulti
End With
With lbxOne
    .ColumnCount = 14
    .ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;0;0;60"
    .ColumnHeads = True
    .RowSource = "=Report!B9:O18"
    .MultiSelect = fmMultiSelectSingle
End With

Yes, jobs amounts over and under budget can and will vary.

I had not thought of using a button to lock in the values of the textboxes. I like this idea very much. Without it the users would probably pull their hair out.

I'm working on limiting the selection to five in lbxTwo. I think a proportional (as you've called it) adjustment would be the way to go. The user could slowly trickle down their adjustments one textbox at a time while locking in the values with a button as you suggested.

Thank you again for looking,

John

 

[pbornemeier]

Values to the nearest dollar or nearest penny? Spin box changing by pennies will take a long time to make a 50 dollar shift. (about 1 dollar every 7 seconds)

This code in a module will populate your listboxes that meet your criteria:
Code expects that Job data starts in row 9 name in column B, amount over in column C, amount under in column D

Option Explicit

Sub PopulateListBoxWithFileNameExt()
    'Standard Module
    
    Dim lLastJobRow As Long
    Dim lRowIndex As Long
    Dim aryOver() As Variant
    Dim lOverIndex As Long
    Dim aryUnder() As Variant
    Dim lUnderIndex As Long
    Dim bHighlightO As Boolean
    Dim bHighlightU As Boolean
    
    With Worksheets("Report")
        lLastJobRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For lRowIndex = 9 To lLastJobRow
            'Add OverBudget jobs to lbxOver
            If .Cells(lRowIndex, 3) <> 0 Then
                lOverIndex = lOverIndex + 1
                ReDim Preserve aryOver(1 To 2, 0 To lOverIndex)
                aryOver(1, lOverIndex) = .Cells(lRowIndex, 2).Value
                aryOver(2, lOverIndex) = .Cells(lRowIndex, 3).Value
            End If
            If .Cells(lRowIndex, 4) <> 0 Then
                lUnderIndex = lUnderIndex + 1
                ReDim Preserve aryUnder(1 To 2, 0 To lUnderIndex)
                aryUnder(1, lUnderIndex) = .Cells(lRowIndex, 2).Value
                aryUnder(2, lUnderIndex) = .Cells(lRowIndex, 4).Value
            End If
        Next
        'Headings
        aryOver(1, 0) = "Name"
        aryOver(2, 0) = "Amt Over"
        aryUnder(1, 0) = "Name"
        aryUnder(2, 0) = "Amt Under"
            
        
    End With
    
    frmBalance.lbxOver.List = Application.Transpose(aryOver)
    frmBalance.lbxUnder.List = Application.Transpose(aryUnder)
    frmBalance.lbxOver.Selected(0) = True
    frmBalance.lbxUnder.Selected(0) = True
    frmBalance.Show
    
End Sub

This code in frmbalance

Option Explicit

Dim bHighlightO As Boolean
Dim bHighlightU As Boolean

Private Sub spn1_Change()
    Me.txtSel1 = spn1.Value
End Sub

Private Sub UserForm_Initialize()
     bHighlightO = True
     bHighlightU = True
End Sub

Private Sub lbxOver_Change()
    If Not bHighlightO Then
        If Me.lbxOver.Selected(0) Then Me.lbxOver.Selected(0) = False
    End If
    bHighlightO = False
End Sub

Private Sub lbxUnder_Change()
    If Not bHighlightU Then
        If Me.lbxUnder.Selected(0) Then Me.lbxUnder.Selected(0) = False
    End If
    bHighlightU = False
End Sub

 

[pbornemeier]

A suggestion. Select the job that has gone overbudget.
If the total of the 5 largest UB amounts is not greater or equal to the OB amount, display that info....I am not sure what you want to do in that case.
As the under budget jobs are chosen, keep track of and display the under budget cumulative total. When the cumulative total exceeds the amount of the over budget, populate the listbox/spinbutton/chkbox lock rows with the maximum of each of the smaller UB jobs and enough of the largest UB job to cover the over budget amount, setting the lock checkbox on the smaller jobs. If the 5th job is selected and the cumulative UB amount is less than the OB, display that in a text box that is not blocked by the UB list box. Then let the user play with the lock and spin buttons to distribute amounts as desired.

ScrollBars may be better than SpinButton since you can set a small change amount (pennies), a small change amount (dollars) and drag the scroll box for very large changes over the specified range.

 

[Stephenosn]

Phil,

Thank you so much. You make a very good point about adjusting the values by the pennies. Although that would be a funny and cruel trick I think it is much smarter to make the adjustments by the dollar as you suggest.
I'm going to get to work trying this. I will let you know how everything goes.


Thank you,

John

 

[Stephenosn]

Phil,

I had not seen your most recent post when replying before.

Once again you make great suggestions on areas I had not given consideration.

I will put a TextBox on the UserForm for the total amount UB of the selected jobs. There does need to be a system in place to keep the UB jobs from becoming OB jobs. I think that the amount distributed would need to be less than the sum of the amount UB jobs in the case that the OB job exceeds that sum.

I have not used ScrollBars before, but they sound like a much better way to go. I will play with them today and see if I can get them figured out.

Thank you for your thorough and thoughtful suggestions.

Regards,

John

 

[Stephenosn]

Hello,

I have added a TextBox tbTotal to add up my values amounts under budget using the following code. I've put this in a button on click event, but maybe there is a better place for it?

 Dim Total As Double    Total = 0
    If Len(tbOne.Value) > 0 Then Total = Total + CDbl(tbOne.Value)
    If Len(tbTwo.Value) > 0 Then Total = Total + CDbl(tbTwo.Value)
    If Len(tbThree.Value) > 0 Then Total = Total + CDbl(tbThree.Value)
    If Len(tbFour.Value) > 0 Then Total = Total + CDbl(tbFour.Value)
    If Len(tbFive.Value) > 0 Then Total = Total + CDbl(tbFive.Value)
    tbTotal.Value = Total

I've modified your code a bit to keep my values in one column, but for some reason the ListBoxes only show the Job Name and not the value. Am I missing something here? In addition to the code bellow I've also made your suggested changes to the frmAdj code.

Sub PopulateListBoxWithFileNameExt()    'Standard Module
    
    Dim lLastJobRow As Long
    Dim lRowIndex As Long
    Dim aryOver() As Variant
    Dim lOverIndex As Long
    Dim aryUnder() As Variant
    Dim lUnderIndex As Long
    Dim bHighlightO As Boolean
    Dim bHighlightU As Boolean
    
    With Worksheets("Report")
        lLastJobRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For lRowIndex = 3 To lLastJobRow
            'Add OverBudget jobs to lbxOver
            If .Cells(lRowIndex, 3) <= 0 Then
                lOverIndex = lOverIndex + 1
                ReDim Preserve aryOver(1 To 2, 0 To lOverIndex)
                aryOver(1, lOverIndex) = .Cells(lRowIndex, 2).Value
                aryOver(2, lOverIndex) = .Cells(lRowIndex, 3).Value
            End If
            If .Cells(lRowIndex, 3) > 0 Then
                lUnderIndex = lUnderIndex + 1
                ReDim Preserve aryUnder(1 To 2, 0 To lUnderIndex)
                aryUnder(1, lUnderIndex) = .Cells(lRowIndex, 2).Value
                aryUnder(2, lUnderIndex) = .Cells(lRowIndex, 3).Value
            End If
        Next
        'Headings
        aryOver(1, 0) = "Job Name"
        aryOver(2, 0) = "Amt Over"
        aryUnder(1, 0) = "Job Name"
        aryUnder(2, 0) = "Amt Under"
            
        
    End With
    
    frmAdj.lbxOver.List = Application.Transpose(aryOver)
    frmAdj.lbxUnder.List = Application.Transpose(aryUnder)
    frmAdj.lbxOver.Selected(0) = True
    frmAdj.lbxUnder.Selected(0) = True
    frmAdj.Show
    
End Sub

Thank you for looking,

John

 

[pbornemeier]

Rather than in a button on click, for your first code block, put that code in a sub named AddBoxes and for each textbox's Change event call that subroutine. That way when any block is changed, the total will be recalculated.

Did you set the Column Count and Bound column for the listbox to 2? That way 2 columns can be displayed and the value of the box will be the amount (2nd column) and not the name.

Regarding the headings statements. fixed headings can only be shown if the listbox contents are set by a range. With the current code, the headings will be selected and the top row of the listbox. IF the listbox is scrolled they will move out of site. If this is a problem you can put a textbox above the listbox for the headings.