ADO not saving

[uplank]

Hey all,

I have a small issue. If i go into my form (has a DG and ado connection) and add a record (uses button) - it sets up some defaults. If i change the record, the changes arent saved when i close and go back in. But if i then change the record after i go back in the record saves.

Any ideas whats wrong? Code attached

Option Explicit
Dim bInsertRec As Boolean
'Add currency combo in at bottom
'Tax rate
 
 
 
Private Sub CbCurrency_Change()
 
Call CbTransaction_Change
 
End Sub
 
Private Sub CbCurrency_Click()
 
Call CbTransaction_Change
 
End Sub
 
Private Sub CbTaxRate_Change()
 
Call CbTransaction_Change
 
End Sub
 
Private Sub CbTaxRate_Click()
 
Call CbTransaction_Change
 
End Sub
 
Private Sub CbTransaction_Change()
 
If Len(CbTransaction.Text) > 0 And Len(CbCurrency.Text) > 0 And Len(CbTaxRate.Text) > 0 Then
    CmdAddTrans.Enabled = True
Else
    CmdAddTrans.Enabled = False
End If
 
End Sub
 
Private Sub CbTransaction_Click()
 
Call CbTransaction_Change
 
End Sub
 
Private Sub CmdAddTrans_Click()
 
'insert routine
 
StrTaxRate = CbTaxRate
 
If Adodc.RecordSet.RecordCount > 0 Then
 
    Adodc.RecordSet.MoveLast
    
    If IsNull(Adodc.RecordSet.Fields("Total Premium").Value) = True Or Len(Adodc.RecordSet.Fields("Total Premium").Value) = 0 Or Adodc.RecordSet.Fields("Total Premium").Value = 0 Then
        StrMsg = "Premium on last entry not complete.  Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    
    If IsNull(Adodc.RecordSet.Fields("Bordereau Month").Value) = True Then
        StrMsg = "Bordereau Month on last entry not complete.  Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
 
    If IsNull(Adodc.RecordSet.Fields("Bordereau Year").Value) = True Then
        StrMsg = "Bordereau Year on last entry not complete.  Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    
    If Adodc.RecordSet.Fields("Bordereau Month").Value < 1 Or Adodc.RecordSet.Fields("Bordereau Month").Value > 12 Then
        StrMsg = "Bordereau Month on last entry not valid (must be number between 1-12)." & vbCr & _
                "Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    
    If Adodc.RecordSet.Fields("Bordereau Year").Value > DatePart("yyyy", Now) Then
        StrMsg = "Bordereau Month on last entry not valid (cannot be in the future)." & vbCr & _
                "Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    
    If Adodc.RecordSet.Fields("Bordereau Year").Value < DatePart("yyyy", Now) - 1 Then
        StrMsg = "Bordereau Month on last entry not valid (cannot be further then a year in the past)." & vbCr & _
                "Do you wish to remove this entry?"
        Style = vbExclamation + vbYesNo
        StrTitle = App.FileDescription & " - User Error"
        IntResponse = MsgBox(StrMsg, Style, StrTitle)
        If IntResponse = vbYes Then
            Adodc.RecordSet.Delete (adAffectCurrent)
            Exit Sub
        Else
            Exit Sub
        End If
    End If
        
End If
 
DGAgentAccounts.Refresh
 
With Adodc.RecordSet
    .AddNew
    .Fields("Agent number").Value = StrAgentNumber
    .Fields("Transaction date").Value = Now
    .Fields("Transaction Type").Value = CbTransaction.Text
    .Fields("Total Premium").Value = 0
    .Fields("Tax Amount").Value = 0
    .Fields("Currency").Value = CbCurrency.Text
    .Fields("User Name").Value = StrUserName
    .Update
End With
bInsertRec = True
 
DGAgentAccounts.AllowUpdate = True
DGAgentAccounts.SetFocus
Adodc.RecordSet.MoveLast
 
End Sub
 
 
Private Sub DataGrid1_AfterUpdate()
 
'call validate?
End Sub
 
 
 
Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
 
'err handle
 
End Sub
 
Private Sub DGAgentAccounts_AfterColUpdate(ByVal ColIndex As Integer)
Adodc.RecordSet.Fields("Tax Amount").Value = Round(Adodc.RecordSet.Fields("Total Premium").Value - (Adodc.RecordSet.Fields("Total Premium").Value / (1 + StrTaxRate)), 2)
End Sub
 
Private Sub DGAgentAccounts_BeforeInsert(Cancel As Integer)
'Valid
End Sub
 
 
 
Private Sub DGAgentAccounts_KeyDown(KeyCode As Integer, Shift As Integer)
 
If Shift = 1 Then
    If KeyCode = 9 Or KeyCode = 16 Then
        Exit Sub
    Else
        KeyCode = 0
        Beep
    End If
End If
 
Select Case KeyCode
    Case 8, 9, 13, 37 To 40, 46, 48 To 57, 96 To 105, 189
        Exit Sub
    Case 109, 189
        If InStr(DGAgentAccounts.Text, "-") > 0 Then
            KeyCode = 0
            Beep
        End If
    Case 110, 190
        If InStr(DGAgentAccounts.Text, ".") > 0 Then
            KeyCode = 0
            Beep
        End If
    Case Else
        KeyCode = 0
        Beep
End Select
 
end Sub
 
 
Private Sub Form_Load()
 
bInsertRec = False
 
Set DGAgentAccounts.DataSource = Nothing
Adodc.ConnectionString = PLCYConnectionString
Adodc.RecordSource = "Select * from [agent accounts] where [Agent number] ='" & StrAgentNumber & "' order by [transaction date]"
Adodc.Refresh
 
 
 
 
 
Set DGAgentAccounts.DataSource = Adodc
DGAgentAccounts.Columns(0).Visible = False 'Transaction ID
DGAgentAccounts.Columns(1).Visible = False 'Agent number
DGAgentAccounts.Columns(2).Locked = True 'Transaction Date
DGAgentAccounts.Columns(3).Locked = True 'Transaction Type
DGAgentAccounts.Columns(5).Locked = True 'Tax amount
DGAgentAccounts.Columns(6).Locked = True 'Currency
DGAgentAccounts.Columns(9).Locked = True 'Username
 
DGAgentAccounts.AllowUpdate = True
'set fields up which are locked etc
'reference field by ado.rs.field("") etc easy 2 debug!
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
'Call validate
 
'FrmAgentAccounts.Hide
frmAgentsDetails.Show
     
 
End Sub

Any help really appreciated!

Dan

[uplank]

AHA!

I am getting closer.

If after my add i do a refresh then all works perfectly.

Unfortunately if i do a refresh, all the columns i have hidden - appear again.

Short of hiding them all again, any ideas?