VBA Userform

[nelsonsix]

Hi All,

I have created a Userform for a task project I am working on for my job. I am not a programmer and have limited knowledge of excel.

In essence, I have created a form that will be used by about 15-20 people for entering tasks they have completed. The details are then inserted into a worksheet and I can use that data for monitoring workloads and productivity. The problem I can sort of foresee is when multiple users try and enter userform data at the same time.

FYI - The code I have written works perfectly for 1 user.

The code I have used when you click on the 'add' button it finds the top most empty row and enters the details in the form. If more than one person opens the shared workbook at the same time, then each user will be entering their info and it will be inputted on the same row, overwriting each others form data. This is a problem.

The VBA code is below, again, i am not an expert and do not have access to databases. Its a simple project but I want it to work properly.

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Report Entry")


'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'check if completed on xplan
If Trim(Me.chkCompleted.Value) = False Then
  Me.chkCompleted.SetFocus
  Me.lblCompleted.ForeColor = RGB(255, 0, 0) ' red
  MsgBox "Has the report been completed on XPlan?"
  Exit Sub
End If


'copy the data to the database
With ws
'  .Unprotect Password:="password"
  .Cells(lRow, 1).Value = Me.cboPara.Value
  .Cells(lRow, 2).Value = Me.cboReport.Value
  .Cells(lRow, 3).Value = Me.chkCashflow.Value
  .Cells(lRow, 4).Value = Me.txtCeding.Value
  .Cells(lRow, 5).Value = Me.chkAQ.Value
  .Cells(lRow, 6).Value = Me.chkCompleted.Value
  .Cells(lRow, 7).Value = Me.txtDate.Value
'  .Protect Password:="password"
End With


'clear the data
Me.cboPara.Value = ""
Me.cboReport.Value = ""
Me.chkCashflow.Value = False
Me.txtCeding.Value = ""
Me.chkAQ.Value = False
Me.chkCompleted.Value = False
Me.cboPara.SetFocus
Me.lblCompleted.ForeColor = RGB(0, 0, 0) ' black
txtDate.Value = Now
txtDate = Format(txtDate.Value, "dd mmmm yyyy")


End Sub


Private Sub UserForm_Initialize()
Dim cPara As Range
Dim cReport As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupSheet")


For Each cReport In ws.Range("ReportType")
    With Me.cboReport
        .AddItem cReport.Value
    End With
Next cReport


For Each cPara In ws.Range("Paraplanner")
    With Me.cboPara
        .AddItem cPara.Value
    End With
Next cPara




txtDate.Value = Now
txtDate = Format(txtDate.Value, "dd mmmm yyyy")


Me.cboPara.SetFocus


End Sub




Private Sub cmdClose_Click()
    Unload Me
End Sub

My question is, is there anyway to get around this problem with a shared workbook?

Thank you in advance for your help.
Neil

 

[dmt32]

Hi,

Place a commanbutton on sheet in your copy & then place this code in that sheets code page

Private Sub CommandButton2_Click()
    Dim FileName As String
    Dim DatabaseOpenPassword As String, wsDatabasePassword As String
    Dim wbReportDatabase As Workbook


'********************************************************************************************
'*******************************************SETTINGS*****************************************
    FileName = ThisWorkbook.Worksheets("Settings").Range("F10").Text
    
    DatabaseOpenPassword = ""
    
    wsDatabasePassword = ""
    
'********************************************************************************************
    
    
    On Error GoTo exitsub


'check file exists
        If Not Dir(FileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
'open database
            Set wbReportDatabase = Workbooks.Open(FileName, UpdateLinks:=False, ReadOnly:=True, _
                                                            Password:=DatabaseOpenPassword, _
                                                            IgnoreReadonlyRecommended:=True)
                                     
           wbReportDatabase.Worksheets(1).Unprotect Password:=wsDatabasePassword
           
        Else
            MsgBox FileName & Chr(10) & "File Not Found", 48, "Not Found"
        End If
    
                
exitsub:
        If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
 
End Sub

Change the Commandbutton name as required.

Do understand that having a read only copy open whilst users submit their data does not mean you will see real time updates - you won't!

Dave

 

[nelsonsix]

Hi Dave,

Thanks again for this, I couldn't get this to work properly but it is not a big issue.

I have spoken to my boss and she was really happy with the idea of this data tracker and wants it to distributed to the entire company, this means that about 40-50 users will be using the spread sheets and in turn the chance of submitting data at the same time has increased.

What will happen if multiple users try and submit the user form at the same time and is there anyway around this?

Thanks again, sorry to keep asking you for help.

Neil

 

[dmt32]

Hi Dave,

Thanks again for this, I couldn't get this to work properly but it is not a big issue.

I have spoken to my boss and she was really happy with the idea of this data tracker and wants it to distributed to the entire company, this means that about 40-50 users will be using the spread sheets and in turn the chance of submitting data at the same time has increased.

What will happen if multiple users try and submit the user form at the same time and is there anyway around this?

Thanks again, sorry to keep asking you for help.

Neil

Hi,
not sure what the issue is - code should just open a read only copy & not affect master workbook operation.

To answer your other question, the more users you have to great the risk of conflict - about 10 years ago I created a similar approach for my daughter who needed to collect timesheet data each week - she had up to 250 users submitting data & at that time, she did not report any issues - All can suggest is that you test it out & see how you get on - if too many people complain about conflict reports when they submit data then let me know - will have to update code to manage.

Dave

 

[nelsonsix]

Hi,

Thanks for all the help with this problem so far.

I was wondering however, if it is possible to insert the data from the user form in a new worksheet on the users spreadsheet as well as on the separate database.

The reason is I am having complaints that the users do not know what cases have been submitted so a local copy of the submission each user makes would be ideal.

I do not want to give all the users access to the database as this could cause issues if data is deleted or altered.

Thanks again for all your help.
Neil

 

[dmt32]

Hi,

Thanks for all the help with this problem so far.

I was wondering however, if it is possible to insert the data from the user form in a new worksheet on the users spreadsheet as well as on the separate database.

The reason is I am having complaints that the users do not know what cases have been submitted so a local copy of the submission each user makes would be ideal.

I do not want to give all the users access to the database as this could cause issues if data is deleted or altered.

Thanks again for all your help.
Neil

Hi,
try inserting additions shown below

Private Sub cmdAdd_Click()
    Dim lRow As Long, Lastrow As Long
    Dim FileName As String
    Dim msg As Variant
    Dim DatabaseOpenPassword As String, wsDatabasePassword As String
    Dim wbReportDatabase As Workbook
    Dim LocalDataBase As Worksheet
    
    
'********************************************************************************************
'*******************************************SETTINGS*****************************************
    FileName = ThisWorkbook.Worksheets("Settings").Range("F10").Text
    
    DatabaseOpenPassword = ""
    
    wsDatabasePassword = ""
    
'********************************************************************************************
    
    Set LocalDataBase = ThisWorkbook.Worksheets(1)
    
    With LocalDataBase
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    On Error GoTo exitsub


'check file exists
        If Not Dir(FileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
'open database
            Set wbReportDatabase = Workbooks.Open(FileName, UpdateLinks:=False, _
                                                  ReadOnly:=False, Password:=DatabaseOpenPassword, _
                                                  IgnoreReadonlyRecommended:=True)
    
                With wbReportDatabase
                    
                    With .Worksheets(1)
                      .Unprotect Password:=wsDatabasePassword
'find first empty row in database
                        lRow = .Cells.Find(What:="*", SearchOrder:=xlRows, _
                        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'post form data to the database
                        .Cells(lRow, 1).Resize(, 7).Value = Array(Me.cboPara.Value, Me.cboReport.Value, _
                                                                  Me.chkCashflow.Value, Me.txtCeding.Value, _
                                                                  Me.chkAQ.Value, Me.chkCompleted.Value, _
                                                                  DateValue(Me.txtDate.Value))
'add record to local database
                    LocalDataBase.Cells(Lastrow, 1).Resize(, 7).Value = .Cells(lRow, 1).Resize(, 7).Value
'protect database
                    If Len(wsDatabasePassword) > 0 Then .Protect Password:=wsDatabasePassword
                    End With
'save & close file
                    .Close True


                End With
'save success
                    msg = Array("Record Saved To Database", "Record Saved")
'reset form
                    ResetControls
                
            Else
'file / folder not found
                msg = Array(FileName & Chr(10) & "File Not Found", "Not Found")
                
            End If
'release object variable
        Set wbReportDatabase = Nothing
        
exitsub:
'ensure database workbook closed
        If Not wbReportDatabase Is Nothing Then wbReportDatabase.Close False
'refresh screen
        Application.ScreenUpdating = True


        If Err > 0 Then
'report errors
            MsgBox (Error(Err)), 48, "Error"
        Else
'inform user
            MsgBox msg(1), 48, msg(2)
        End If
End Sub

It is assumed that the local database will be the first sheet in the users workbook.


Dave

 

[nelsonsix]

Absolutely perfect, thank you so much!!

Neil