Add button to increment textbox value by 1

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,284
Office Version
  1. 2007
Platform
  1. Windows
Here is my userform code.

The textbox called CustomerID is where the number is stored.
I enter a number & hit enter on my keyboard then the values are shown in the other textboxes.

How can i add a button on the userform so when clicked it either adds 1 to the current value or takes away 1 from the current value & load its values.

Currently im doing it all manully & its very time consuming

Thanks

Rich (BB code):
Private Sub CustomerID_AfterUpdate()
    Dim id As Variant, rowcount As Integer, foundcell As Range
    
    id = CustomerID.Value
    
    rowcount = Sheets("G INCOME").Cells(Rows.Count, 13).End(xlUp).Row ' THIS IS COLUMN NUMBER WHERE EMP ID LOCATED
    
    With Worksheets("G INCOME").Range("M1:M" & rowcount) ' THIS IS CELL REFERENCE OF WHERE THE TEXT EMP ID IS LOCATED
        Set foundcell = .Find(what:=id, LookIn:=xlValues)
        
        If Not foundcell Is Nothing Then
            TextBox1.Value = .Cells(foundcell.Row, 2)
            TextBox2.Value = .Cells(foundcell.Row, 3)
            TextBox3.Value = .Cells(foundcell.Row, 4)
            TextBox4.Value = .Cells(foundcell.Row, 5)
            TextBox5.Value = .Cells(foundcell.Row, 6)
        
         Else
          MsgBox "CUSTOMER'S ID IS INCORRECT", vbCritical, "CUSTOMER ID IS INCORRECT MESSAGE"
        
    End If
    End With
End Sub
    Private Sub TransferValues_Click()
    Dim Lastrow        As Long, i As Long
    Dim wsGIncome      As Worksheet
    Dim arr(1 To 5)    As Variant
    Dim Prompt         As String
   
    Set wsGIncome = ThisWorkbook.Worksheets("G INCOME")
   
    For i = 1 To UBound(arr)
        arr(i) = Choose(i, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, TextBox5.Value)
       
        If Len(arr(i)) = 0 Then
            MsgBox "YOU MUST COMPLETE ALL THE FIELDS", vbCritical, "USERFORM FIELDS EMPTY MESSAGE"
            Exit Sub
        End If
    Next i
   
    Application.ScreenUpdating = False
   
    With wsGIncome
        Lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row + 1
       
       With .Cells(Lastrow, 14).Resize(, UBound(arr))
            .Value = arr
            .Font.Name = "Calibri"
            .Font.Size = 11
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 6
           
            .Cells(1, 1).HorizontalAlignment = xlLeft
            Application.ErrorCheckingOptions.BackgroundChecking = False
       End With
           With Sheets("G INCOME")
           If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("N4:S" & x).Sort Key1:=Range("N4"), Order1:=xlAscending, Header:=xlGuess
           End With
         Unload SAMECUSTOMER
         .Range("N4").Select
       End With
       Application.ScreenUpdating = True
End Sub
 
The CustomerID_Change event is triggered every time you make a change in the control (whether you type it yourself or the code does it). So when you want to enter, for example, 15, you will first type 1 - the _Change event will be triggered and the data for ID=1 will be found, then you will type 5 then the data for ID=15 will be found. If the given ID does not exist, the text boxes from 1 to 5 will be cleared. Fact, I didn't anticipate that the CustomerID field could be cleared or an unexpected value (such as text) was entered. This can be fixed easily by replacing the line in the CustomerID_Change procedure:
Code:
Id = CustomerID.Value
to
Code:
    On Error Resume Next
    Id = CLng(CustomerID.Value)
    
    If Err.Number <> 0 Then
        Id = 0
    End If
    On Error GoTo 0
I specifically disabled the message about not found data, which could make it difficult to enter the ID. Let me remind you that when the ID is not found the controls are cleared.

Artik
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
I disagree with something you have said or doesnt do what you have said & hence my last reply or two.

I type 1 in the ID field & the caustomers values are shown for ID1
I then continue by typing 5 so now the customer with ID 15 is show.
THE ABOVE IS TRUE & WORKS.

BUT

If by mistake 5 is hit twice so ID now reads 155 your saying all fields are cleared, This is what doesnt happen.
What happens is i get a RTE 380
This means there is no ID 155 hence the RTE

In my old code IF the ID was not present the user would see a Msgbox.

See screenshot

Th ID 15 was entered & the values are shown.
This customer can also be seen in userform / worksheet.

I then entered another 5 thus making ID 155 & the RTE now gets shown
 

Attachments

  • EaseUS_2024_05_14_16_16_01.jpg
    EaseUS_2024_05_14_16_16_01.jpg
    103.6 KB · Views: 4
Upvote 0
Playing with it a little i see the RTE is only shown If the user enters the number manually.
If the spin button is used then Yes i agree that the textboxes are cleared
 
Upvote 0
When the SpinButton control is inserted into the form, it has default property settings: Min=0 and Max=100. Therefore, when you enter 155 in the CustomerID field, an error appears because the maximum value has been exceeded.

If the form does not have the ability to add new records (new CustomerID), then program the UserForm_Initialize event to set the appropriate value of the Max property of the SpinButton1 control.

Below is the full code for the CustomerID, SpinButton1 and ClearValues controls.
VBA Code:
Option Explicit

Dim AbortProc As Boolean

Private Sub CustomerID_Change()
    Dim id As Long
    Dim rowcount As Long, foundcell As Range
    Dim lRow As Long
    Dim i As Long

    On Error Resume Next
    'Handling in case of an empty string or text value
    id = CLng(Me.CustomerID.Value)
    On Error GoTo 0

    'Handling in case the maximum value of SpinButton1 is exceeded
    If id > Me.SpinButton1.Max Then
        MsgBox "CustomerID out of range!", vbExclamation
        Exit Sub
    Else
        'ID value within the required range
        AbortProc = True
        Me.SpinButton1.Value = id
        AbortProc = False
    End If


    With Worksheets("G INCOME")
        rowcount = .Cells(.Rows.Count, "M").End(xlUp).Row    ' THIS IS COLUMN NUMBER WHERE EMP ID LOCATED

        With .Range("M1:M" & rowcount)    ' THIS IS CELL REFERENCE OF WHERE THE TEXT EMP ID IS LOCATED
            Set foundcell = .Find(what:=id, LookIn:=xlValues)

            If Not foundcell Is Nothing Then
                lRow = foundcell.Row
                For i = 1 To 5
                    Me.Controls("TextBox" & i).Value = .Cells(lRow, i + 1)
                Next i

            Else
                Call ClearForm(False)
            End If
        End With
    End With

End Sub


Private Sub SpinButton1_Change()
    If AbortProc Then Exit Sub
    Me.CustomerID.Value = Me.SpinButton1.Value
End Sub


Private Sub ClearValues_Click()
    Call ClearForm
End Sub


Private Sub UserForm_Initialize()
    Call SetSpinButtonMax
End Sub


Private Sub ClearForm(Optional ClearID As Boolean = True)
    Dim i As Long

    For i = 1 To 5
        Me.Controls("TextBox" & i).Value = vbNullString
    Next i
    
    AbortProc = True
    Me.SpinButton1.Value = 0
    AbortProc = False

    If ClearID Then
        With Me.CustomerID
            .Value = vbNullString
            .SetFocus
        End With
    End If

End Sub


Private Sub SetSpinButtonMax()
    Dim rowcount As Long
    Dim lMax As Long

    With ThisWorkbook.Worksheets("G INCOME")
        rowcount = .Cells(.Rows.Count, "M").End(xlUp).Row    'column with IDs
        lMax = Application.Max(.Range("M1:M" & rowcount))
    End With

    With Me.SpinButton1
        .Min = 0
        .Value = 0
        .Max = lMax
    End With

End Sub
Artik
 
Upvote 0

Forum statistics

Threads
1,217,055
Messages
6,134,330
Members
449,866
Latest member
veeraiyah

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