Sum of UserForm TextBoxes doesn't work over 999.99

D

Darranimo

Board Regular
Joined
Jan 19, 2022
Messages
52
Office Version
  1. 365
Platform
  1. Windows
I have a userform that has several text boxes that I want to sum and then place in a cell on the worksheet. It works great until any of the four text boxes equals 1,000 or more. Here is the beginning of my code. I have bolded the line that isn't working properly. I'm thinking it has to do with a limitation of the Val() function that I am unaware of. Any help would be greatly appreciated! Thanks!

Rich (BB code): 
Private Sub cmdAdd_click()
    Dim lrw As Long
    Dim acell As Range
    Dim rng As Range
    Dim ws As Worksheet
    Dim comp As String
    On Error Resume Next
   
    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    comp = Me.cboCompany.Value
   
    Range("dDComp").Value = "'" & Left(comp, 8)
    Range("dDCompName").Value = comp
    Set ws = Sheets("Line Types")
    Set acell = Worksheets("GL Import Data Batches").Range("A" & lrw + 1)
    Set rng = ws.Range("Rebate")
   
    If Left(comp, 4) = "2311" Then Range("dLH").Value = "H"
    If Left(comp, 4) = "2310" Then Range("dLH").Value = "L"
          
    rng.Copy acell
   
    acell.Offset(0, 17).Value = txtAmount1.Value
    acell.Offset(4, 17).Value = txtAmount2.Value
    acell.Offset(8, 17).Value = txtAmount3.Value
    acell.Offset(12, 17).Value = txtAmount4.Value
    acell.Offset(16, 17).Value = txtAmount5.Value
    acell.Offset(20, 17).Value = txtAmount6.Value
    acell.Offset(24, 17).Value = Val(txtAmount7.Value) + Val(txtAmount8.Value) + Val(txtAmount9.Value) + Val(txtAmount10.Value)
    acell.Offset(26, 17).Value = txtAmount7.Value
    acell.Offset(30, 17).Value = txtAmount8.Value
    acell.Offset(34, 17).Value = txtAmount9.Value
    acell.Offset(38, 17).Value = txtAmount10.Value
 
Last edited by a moderator:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
You may want to remove the 'On Error Resume Next' at the beginning, or add 'On Error GoTo 0' before any of the cells are assigned a value (e.g. acell.Offset(0, 17).....) to see if an error comes up at that point. I created a simple form with four textboxes and had no issue entering or summing large numbers and assigning it to a cell value.
 
Upvote 0
Z51 said:
You may want to remove the 'On Error Resume Next' at the beginning, or add 'On Error GoTo 0' before any of the cells are assigned a value (e.g. acell.Offset(0, 17).....) to see if an error comes up at that point. I created a simple form with four textboxes and had no issue entering or summing large numbers and assigning it to a cell value.
Click to expand...
I tried that and still no luck. I do have the following coding for the textboxes after updating. Would this affect it at all? I can't see how...

VBA Code: 
Private Sub txtAmount1_AfterUpdate()
    Dim txt As Object
    Set txt = Me.txtAmount1
        
    With txt
        If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0.00")
        If txt.Value = "" Then txt.Value = "0.00"
    End With
End Sub

Here is the full code for hopefully more context:

VBA Code: 
Private Sub cmdAdd_click()
    Dim lrw As Long
    Dim acell As Range
    Dim rng As Range
    Dim ws As Worksheet
    Dim comp As String
    'On Error Resume Next
    
    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    comp = Me.cboCompany.Value
    
    Range("dDComp").Value = "'" & Left(comp, 8)
    Range("dDCompName").Value = comp
    Set ws = Sheets("Line Types")
    Set acell = Worksheets("GL Import Data Batches").Range("A" & lrw + 1)
    Set rng = ws.Range("Rebate")
    
    If Left(comp, 4) = "2311" Then Range("dLH").Value = "H"
    If Left(comp, 4) = "2310" Then Range("dLH").Value = "L"
           
    rng.Copy acell
    
    acell.Offset(0, 17).Value = txtAmount1.Value
    acell.Offset(4, 17).Value = txtAmount2.Value
    acell.Offset(8, 17).Value = txtAmount3.Value
    acell.Offset(12, 17).Value = txtAmount4.Value
    acell.Offset(16, 17).Value = txtAmount5.Value
    acell.Offset(20, 17).Value = Val(txtAmount6.Value)
    acell.Offset(24, 17).Value = Val(txtAmount7.Value) + Val(txtAmount8.Value) + Val(txtAmount9.Value) + Val(txtAmount10.Value)
    acell.Offset(26, 17).Value = txtAmount7.Value
    acell.Offset(30, 17).Value = txtAmount8.Value
    acell.Offset(34, 17).Value = txtAmount9.Value
    acell.Offset(38, 17).Value = txtAmount10.Value
    
    acell.Offset(0, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(4, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(8, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(12, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(16, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(20, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(24, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(26, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(30, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(34, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(38, 18).Value = txtSupplier.Value & " " & txtReference.Value

    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    Range("A8", "T" & lrw).Select
    Selection.Copy
    Range("A8").PasteSpecial xlPasteValues

    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    Set acell = Worksheets("GL Import Data Batches").Range("A" & lrw + 1)
    For rng2 = lrw To 8 Step -1
        If Cells(rng2, 18) = 0 Then
            Rows(rng2).Delete
        End If
    Next
    
    acell.Select
    
End Sub
 
Upvote 0
Darranimo said:
I tried that and still no luck. I do have the following coding for the textboxes after updating. Would this affect it at all? I can't see how...

VBA Code: 
Private Sub txtAmount1_AfterUpdate()
    Dim txt As Object
    Set txt = Me.txtAmount1
       
    With txt
        If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0.00")
        If txt.Value = "" Then txt.Value = "0.00"
    End With
End Sub

Here is the full code for hopefully more context:

VBA Code: 
Private Sub cmdAdd_click()
    Dim lrw As Long
    Dim acell As Range
    Dim rng As Range
    Dim ws As Worksheet
    Dim comp As String
    'On Error Resume Next
   
    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    comp = Me.cboCompany.Value
   
    Range("dDComp").Value = "'" & Left(comp, 8)
    Range("dDCompName").Value = comp
    Set ws = Sheets("Line Types")
    Set acell = Worksheets("GL Import Data Batches").Range("A" & lrw + 1)
    Set rng = ws.Range("Rebate")
   
    If Left(comp, 4) = "2311" Then Range("dLH").Value = "H"
    If Left(comp, 4) = "2310" Then Range("dLH").Value = "L"
          
    rng.Copy acell
   
    acell.Offset(0, 17).Value = txtAmount1.Value
    acell.Offset(4, 17).Value = txtAmount2.Value
    acell.Offset(8, 17).Value = txtAmount3.Value
    acell.Offset(12, 17).Value = txtAmount4.Value
    acell.Offset(16, 17).Value = txtAmount5.Value
[COLOR=rgb(226, 80, 65)]    acell.Offset(20, 17).Value = Val(txtAmount6.Value)[/COLOR]
    acell.Offset(24, 17).Value = Val(txtAmount7.Value) + Val(txtAmount8.Value) + Val(txtAmount9.Value) + Val(txtAmount10.Value)
    acell.Offset(26, 17).Value = txtAmount7.Value
    acell.Offset(30, 17).Value = txtAmount8.Value
    acell.Offset(34, 17).Value = txtAmount9.Value
    acell.Offset(38, 17).Value = txtAmount10.Value
   
    acell.Offset(0, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(4, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(8, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(12, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(16, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(20, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(24, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(26, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(30, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(34, 18).Value = txtSupplier.Value & " " & txtReference.Value
    acell.Offset(38, 18).Value = txtSupplier.Value & " " & txtReference.Value

    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    Range("A8", "T" & lrw).Select
    Selection.Copy
    Range("A8").PasteSpecial xlPasteValues

    lrw = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    Set acell = Worksheets("GL Import Data Batches").Range("A" & lrw + 1)
    For rng2 = lrw To 8 Step -1
        If Cells(rng2, 18) = 0 Then
            Rows(rng2).Delete
        End If
    Next
   
    acell.Select
   
End Sub
Click to expand...
Also, if you look at the red line above. I added the Val() function to it. The result is the same... up to 999.99 it returns correctly. 1,000 and above the result is divided by 1,000.
 
Upvote 0
I resolved it!!! I need to use CDbl instead of Val since my textbox formatting had a comma.
 
Upvote 0
Solution
You must log in or register to reply here.

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

Share this page

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