Select All, Copy and Paste New VBA (1 Viewer)

[Ash1]

I have a form with a subform, the form limits the qry and the subform displays the results.

I need a VBA that selects all records, copies those records AND if possible, updates the first field (date) to the day after the copied date within the same subform.

There are fourteen fields, the first is the date field.

I tried
subform.setfocus
DoCmd.RunCommand acSelectAllRecords
DoCmd.RunCommand acCopy
DoCmd.RunCommand acPasteAppend

but this didn't work - the result was the form closing, opeining only the subform and pasting only the first field in a single new record.

I can do this manually by selecting all records, right click - copy, right click - paste, and manually updating the date field, but there MUST be a better way...

 

[Rx_]

This might be a demo db worth looking at to see a good subform example.
http://www.access-programmers.co.uk/forums/showthread.php?t=153458

 

[Ash1]

If I mentioned that I know I do not have a normalized datastructure... all of the information must go into a single table - I have no control over the table.... would I still be able to run a VBA to do what I am hoping is possible?

 

[Rx_]

There are several options.
In the data tab record source, a SQL statement can be used instead of a table or query name.
Another method is to create a Recordset and then navigate through it using code with logic.

The function below (if made public) could even be used in a individual field in a Query. Example
Select MyPrimaryData, User_ID, IsUserApproved([User_ID]) as MyApproval
From MySpecialTable

The function IsUserApproved can take the User_ID function and somehow figure out the complexity of a non-relational table.

This is a very simple function example. The function could just as easy have a Case statement with a dozen complex options that follow a complex set of business rules or government regulations.

Function IsUserApproved(User_ID As String) As Boolean
    Dim db As DAO.Database          'This database.
    Dim rs As DAO.Recordset         'To retrieve the value to find.
    Dim StrSQL As String            'SQL statement.
On Error GoTo errTrap
    IsUserApproved = False
    StrSQL = "SELECT tbl_Users.User_ID, tbl_Users.Activity, tbl_Users.Permit "
    StrSQL = StrSQL & "FROM tbl_Users "
    StrSQL = StrSQL & "WHERE (((tbl_Users.User_ID)= '" & User_ID & "') AND ((tbl_Users.Activity)='A') AND ((tbl_Users.Permit)='A'));"

    Set db = DBEngine(0)(0)
    Set rs = db.OpenRecordset(StrSQL, dbOpenForwardOnly, dbSeeChanges)
      'Debug.Print "recordcount " & rs.RecordCount & " and " & rs.Fields(2).Value
      If rs.RecordCount > 0 Then
        IsUserApproved = True
    End If
    Set rs = Nothing
    Set db = Nothing
    Debug.Print "The  user_ID matches an approved name " & IsUserApproved
Exit Function
errTrap:
Debug.Print "IsUserApproved Function had an error, because you are ugly " & Err.Description
Err.Clear
End Function