Form doesnt subtract correctly

[ipbr21054]

Hi,
Please could you check my forms code as there is an issue with subtraction.
My Worksheet is my database & i have a userform which can add new entries or edit existing entries.

I have an autosum in Cell O1 on my worksheet

=sum(O5:O60)

Current autosum total is £2,000.00

I then open up the userform & select a customer,there invoice was £122.50
So lets say it should of been £102.50
I then edit the figure from £122.50 to £102.50 on the userform & save it.
This is a difference of £20.00

Looking on my worksheet the figure has also changed correctly to £102.50 for this customer.

But my autosum shows £1,877.50

What the forms code has actually done is just saved the edit i made from £122.50 to £102.50
BUT has subtracted the original value of £122.50 from my original balance £2000

Dim ws As Worksheet
Dim r As Long
Const StartRow As Long = 6


Private Sub ImageClose_Click()
    'close the form (itself)
    Unload Me
End Sub

Private Sub NewRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Caption = "ADD NEW CUSTOMER TO DATABASE")
    
    ResetButtons IsNewCustomer
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlPrevious)


    'if new customer, add Date
    If IsNewCustomer Then
        Me.txtJobDate.Text = Format(Date, "dd/mm/yyyy")
        Me.txtCustomer.SetFocus
    End If
    
    
End Sub


Private Sub NextRecord_Click()
    Navigate Direction:=xlNext
End Sub


Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub


Private Sub UpdateRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    Dim msg As String
    
    IsNewCustomer = CBool(Me.UpdateRecord.Caption = "SAVE NEW CUSTOMER TO DATABASE")
    
    msg = "CHANGES SAVED SUCCESSFULLY"
    
    If IsNewCustomer Then
    'New record - check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
        r = StartRow
        msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i
    'tell user what happened
    MsgBox msg, 48, msg
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
ActiveWorkbook.Save
End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "CANCEL", "ADD NEW CUSTOMER TO DATABASE")
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
    End With
    
    Me.UpdateRecord.Caption = IIf(Status, "SAVE NEW CUSTOMER TO DATABASE", "SAVE CHANGES FOR THIS CUSTOMER")
End Sub


Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Database")
    Me.UpdateRecord.Caption = "SAVE CHANGES FOR THIS CUSTOMER"
    Me.NewRecord.Caption = "ADD NEW CUSTOMER TO DATABASE"
    'start at first record
    Navigate Direction:=xlFirst
End Sub




Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).ROW
    
    r = IIf(Direction = xlPrevious, r - 1, r + xlNext)
    
    'ensure value of r stays within data range
    If r < StartRow Then r = StartRow
    If r > LastRow Then r = LastRow
    
    'get record
    For i = 1 To UBound(ControlNames)
         Me.Controls(ControlNames(i)).Text = IIf(Direction = xlNone, "", ws.Cells(r, i).Text)
    Next i
    
    Me.Caption = "Database"
    
    'set enabled status of next previous buttons
    Me.NextRecord.Enabled = IIf(Direction = xlNone, False, r < LastRow)
    Me.PrevRecord.Enabled = IIf(Direction = xlNone, False, r > StartRow)


End Sub

Module code

 Option Base 1

Function ControlNames() As Variant
ControlNames = Array("txtCustomer", "txtRegistrationNumber", "txtBlankUsed", "txtVehicle", _
                    "txtButtons", "txtKeySupplied", "txtTransponderChip", "txtJobAction", _
                    "txtProgrammerCloner", "txtKeyCode", "txtBiting", "txtChassisNumber", _
                    "txtJobDate", "txtVehicleYear", "txtPaid")
End Function




Function IsComplete(ByVal Form As Object) As Boolean
    Dim i As Integer
    For i = 1 To UBound(ControlNames)
        IsComplete = CBool(Len(Form.Controls(ControlNames(i)).Text) > 0)
        If Not IsComplete Then
            MsgBox "PLEASE COMPLETE ALL FIELDS", 16, "Entry Required"
            Form.Controls(ControlNames(i)).SetFocus
            Exit Function
        End If
    Next i
End Function

 

[dmt32]

Hi,
I suspect that you are entering the £ symbol? if so, then what you are returning to the cell is probably text which may explain the problem of your formula not updating the cell.

Try this change to this part of your UpdateRecord_Click code & see if helps:

For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
                ws.Cells(r, i).Value = CDbl(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i

Dave

 

[ipbr21054]

That seems to have done the trick.

Thanks very much Dave.