0

I have created a user form in excel to save my records in a sheets like sheet1. But after few days working with this UserForm, it is now goes slower, because of heavy data saving in sheet1. Now I want to save all records to a database and want to keep clean my sheet1. So I can work on my UserForm easily or without any delay. Also wants updates my record by calling it via serial numbers. but I don't want to keep any record in my sheet1.

my little code is below: -

Sub cmdAdd_Click()
    On Error GoTo ErrOccured
    BlnVal = 0

    If BlnVal = 0 Then Exit Sub
      
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Dim txtId, txtName, GenderValue, txtLocation, txtCNum, txtEAddr, txtRemarks
    Dim iCnt As Integer
    
    iCnt = fn_LastRow(Sheets("Data")) + 1
    
    If frmData.obMale = True Then
       GenderValue = "Male"
    Else
       GenderValue = "Female"
    End If

    With Sheets("Data")
        .Cells(iCnt, 1) = iCnt - 1
        .Cells(iCnt, 2) = frmData.txtName
        .Cells(iCnt, 3) = GenderValue
        .Cells(iCnt, 4) = frmData.txtLocation.Value
        .Cells(iCnt, 5) = frmData.txtEAddr
        .Cells(iCnt, 6) = frmData.txtCNum
        .Cells(iCnt, 7) = frmData.txtRemarks
      
            .Columns("A:G").Columns.AutoFit
            .Range("A1:G1").Font.Bold = True
            .Range("A1:G1").LineStyle = xlDash
            
        End If
    End With

    Dim IdVal As Integer

    IdVal = fn_LastRow(Sheets("Data"))

    frmData.txtId = IdVal
    
ErrOccured:
    'TurnOn screen updating
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

I will always be grateful to you.

1 Answers1

0

Then, please try the next way. I will try creating of the necessary DB, table and fields using Excel VBA, too:

  1. Copy the next piece of code which will create an empty DB, on the path you want:
Sub CreateEmptyDB()
 Dim strPath As String, objAccess As Object

 strPath = "C:\Your path\testDB"
 Set objAccess = CreateObject("Access.Application")
 Call objAccess.NewCurrentDatabase(strPath)

 objAccess.Quit
End Sub
  1. Programatically create the necessary table with its fields (`Start Date' added only to see how this type of data is handled...):
Sub createTableFields()
 'It needs a reference to `Microsoft ActiveX Data Objects 2.x Library` (x = 2 to 9)
 Dim Catalog As Object, cn As ADODB.Connection
 Dim dbPath As String, scn As String, strTable As String

 dbPath = "C:\Teste VBA Excel\testAccess\testDB.accdb"
 strTable = "MySpecial_Table"
 
 scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";"

 Set Catalog = CreateObject("ADOX.Catalog")
 Set cn = New ADODB.Connection

 With cn
    .Open scn
    .Execute "CREATE TABLE " & strTable & " ([Name] text(255) WITH " & _
         "Compression, " & "[Gender] text(255) WITH Compression, " & _
         "[Location] text(255) WITH Compression, " & _
         "[Address] text(255) WITH Compression, " & _
         "[Number] number, " & _
         "[Remarks] text(255) WITH Compression, " & _
         "[Start Date] datetime)"
 End With
 cn.Close
End Sub
  1. Add records to the newly created DB/Table:
Sub FillDataInDB()
   'It needs a reference to `Microsoft ActiveX Data Objects 2.x Library` (x = 2 to 9)
   Dim AccessDB As String, strTable As String, sql As String
   Dim con As ADODB.Connection, rs As ADODB.Recordset, lastNo As Long
   
   AccessDB = "C:\Teste VBA Excel\testAccess\testDB.accdb"
   strTable = "MySpecial_Table"
   
   Set con = CreateObject("ADODB.connection")
   con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessDB
   
   sql = "SELECT * FROM " & strTable
   Set rs = CreateObject("ADODB.Recordset")
    rs.CursorType = 1   'adOpenKeyset on early binding
    rs.LockType = 3     'adLockOptimistic on early binding
    
    rs.Open sql, con
     If rs.RecordCount = 0 Then
        lastNo = 0 'when no records in the table
     Else
        rs.MoveLast: lastNo = rs("Number") 'the last recorded value
     End If
     rs.AddNew
       rs("Name") = "Test name"              'frmData.txtName
       rs("Gender") = "Test gender"          'GenderValue
       rs("Location") = "Test Location"      'frmData.txtLocation.Value
       rs("Address") = "Test Address"        'frmData.txtEAddr
       rs("Number") = IIf(lastNo = 0, 100, lastNo + 1) 'auto incrementing against the last value
                                                       'but starting from 100
                                                       'you can use frmData.txtCNum
       rs("Remarks") = "Remarkable table..." 'frmData.txtRemarks
       rs("Start Date") = Date
     rs.Update
    rs.Close: con.Close
    
    Set rs = Nothing: Set con = Nothing
End Sub
  1. Run the first two pieces of code in consecutive order (only once) and then start playing with the third one...

  2. You can read the newly created DB Table (returning in an Excel sheet) in this way:

Sub ADO_Connection_ReadTable()
 Dim conn As New Connection, rec As New Recordset, sh As Worksheet
 Dim AccessDB As String, connString, query As String, strTable As String
 
 AccessDB = "C:\Teste VBA Excel\testAccess\testDB.accdb"
 strTable = "MySpecial_Table"
 Set sh = ActiveSheet 'use here the sheet you want
 connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessDB
 
 conn.Open connString
 query = "SELECT * from " & strTable & ";"
 
 rec.Open query, conn
 'return in the sheet
 sh.cells.ClearContents
 'getting data from the recordset if any and returning some in columns A:B:
 If (rec.RecordCount <> 0) Then
    Do While Not rec.EOF
        With sh.Range("A" & sh.cells(Rows.count, 1).End(xlUp).row).Offset(1, 0)
            .Value2 = rec.fields(0).Value
            .Offset(0, 1).Value2 = rec.fields(3)
        End With
        rec.MoveNext
    Loop
 End If

 rec.Close: conn.Close
End Sub

You can use a query to return specific data according to a specific table field. You can find plenty of examples on the internet.

I tried also showing how to handle an automate recording for the 'Number' field. Of course, if you are able to keep track of it in a different way, you can record it as you need/wont.

Please, test the above code(s) and send some feedback. You can use the DB path as a Private constant at the module level and much other ways to optimize the code. It is just a minimum workable solution only showing the way... :)

FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • You are my favorite @FaneDuru. Love You. Just a little changes required [link](https://stackoverflow.com/questions/5349580/compiler-error-user-defined-types-not-defined). We need to enable **Microsoft ActiveX Data Objects 2.5 Librar** from **Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library"** – Prabhat Vishwas Feb 18 '21 at 05:42
  • @Prabhat Vishwas: Glad I could help! And yes, I should remember to mention that. Even if the code could be designed to use late binding. I only tried to create the simplest way for somebody not familiar with such an approach and of course, I had a reference to 'Microsoft ActiveX Data Objects 2.8 Library' and many others and forgot mentioning something about it. If you would say something about the error I could immediately tel you what is it about... I used a testing Workbook with a lot of references and my collection of nice pieces of code I created in the last time. I will mention now. – FaneDuru Feb 18 '21 at 08:00