VBA User Form in a shared workbook

[Nikijune]

Hello,

I have searched high and low but to no avail. Please can anyone help...?

I have built a user form in excel, which I need to be updated by multiple users, so I have shared the workbook. Upon clicking 'Save' the date is transferred to the next available line in 'Sheet2' however I am struggling to find a way for multiple users to update the sheet. Currently we get the error message come up asking if the user wants to override the changes made by another user.

Some threads that I have read advise to save the sheet, before updating. I tried to do this, but I cant be sure I am doing this correctly or even in the right place.

Any ideas on how I can get round this problem?

I have about 50 users, and the staff turn over is quite high

Thanks in advance

 

[dmt32]

Hi,
You will find that the general consensus of opinion about shared workbooks here is Don’t!

However, one suggestion which you can explore is to provide each user with their own copy of the workbook which you would programme to write their input data to a summary sheet in another workbook (database) on your network.

Solution has its limitations but should avoid the issues you are experiencing.

Others here may have alternative suggestions

Hope helpful

Dave.

 

[Nikijune]

Hello Dave,

Thanks for coming back to me.

I have been playing around with my form this morning, and having a little bit of a problem with exporting the data to another workbook. Seems like it should be quite simple.

My code activates the new workbook, but isn't saving the data. It populates it, but when I added the command to save and close the new workbook, it doesn't actually save.

Here is my code, (sorry, I don't know how to paste it to look like normal code )

Workbooks.Open "O:\Customer Operations\Operational Excellence\Reporting\Niki\Payout Productivity\Payout Productivity.xlsx"
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
'Export Data to worksheet
Cells(emptyRow, 1).Value = DateTextBox.Value
Cells(emptyRow, 2).Value = ComboBox1.Value
Cells(emptyRow, 3).Value = HoursWorkedTextBox.Value
Cells(emptyRow, 4).Value = CompleteServicePlansTextBox.Value
Cells(emptyRow, 5).Value = DualAssetTextBox.Value
Cells(emptyRow, 6).Value = ServicePanFailedTextBox.Value
Cells(emptyRow, 7).Value = Proofsand903sTextBox.Value
Cells(emptyRow, 8).Value = RenamingTextBox.Value
Cells(emptyRow, 9).Value = PriorityPayoutTextBox.Value
Cells(emptyRow, 10).Value = PayoutQueriesTextBox.Value
Cells(emptyRow, 11).Value = CancellationTextBox.Value
Cells(emptyRow, 12).Value = BackoutsTextBox.Value
Cells(emptyRow, 13).Value = ManualContrasTextBox.Value
Cells(emptyRow, 14).Value = RemitsTextBox.Value
Cells(emptyRow, 15).Value = FigureFixesTextBox.Value
Cells(emptyRow, 16).Value = SPQueriesTextBox.Value
Cells(emptyRow, 17).Value = SPManualLoadsTextBox.Value
Cells(emptyRow, 18).Value = SPInvoicesTextBox.Value
Cells(emptyRow, 19).Value = SPCancellationsTextBox.Value
Cells(emptyRow, 20).Value = RentalAmendmentsTextBox.Value
Cells(emptyRow, 21).Value = VDATextBox.Value
Cells(emptyRow, 22).Value = ICRTextBox.Value
Cells(emptyRow, 23).Value = FCMChequesTextBox.Value
Cells(emptyRow, 24).Value = NBCampaignAutorisationTextBox.Value
Cells(emptyRow, 25).Value = PostTextBox.Value
Cells(emptyRow, 26).Value = A8ManualLoadsTextBox.Value
Cells(emptyRow, 27).Value = A8ActivationsTextBox.Value
Cells(emptyRow, 28).Value = SeperatingLettersTextBox.Value
Cells(emptyRow, 29).Value = DeclineReportTextBox.Value
Cells(emptyRow, 30).Value = iLearnTextBox.Value
Cells(emptyRow, 31).Value = TrainingTextBox.Value
Cells(emptyRow, 32).Value = SupportTextBox.Value
Cells(emptyRow, 33).Value = GeneralLedgerTextBox.Value
Cells(emptyRow, 34).Value = TextBox7.Value
Cells(emptyRow, 35).Value = MeetingTextBox.Value
Cells(emptyRow, 36).Value = PDRTextBox.Value
Cells(emptyRow, 38).Value = OtherTextBox.Value
Cells(emptyRow, 37).Value = RCHPendingTextBox.Value
Cells(emptyRow, 39).Value = RCHChequesTextBox.Value
Cells(emptyRow, 40).Value = RCHBackoutsTextBox.Value
Cells(emptyRow, 41).Value = RCHLateLoadsTextBox.Value
Cells(emptyRow, 42).Value = NotesTextBox.Value

 

[dmt32]

Hi,
You will need to qualify the input ranges to the worksheet in the database workbook to ensure data goes where intended.

If you can, place copy of your workbook in a dropbox I will look at updating what you are trying to do.

Here is my code, (sorry, I don't know how to paste it to look like normal code )

All you need do is to press the # on menubar which will create code tags - place your code inbetween them.

Dave

 

[Nikijune]

Hi Dave,

I don't have access to dropbox at work.

I only have one worksheet in the workbook that I want the data to export to. Do I need to specify the name of the worksheet within the coding above?

Thanks - Niki

 

[dmt32]

Hi
No worries should be able to resolve here.

Although not how I would write the code, I have stuck with your code & updated a little which hopefully, should now do what you want:

Sub AddToDatabase()
    Dim FolderName As String, FileName As String
    Dim emptyrow As Long
    Dim wbDatabase As Workbook


'initialize variables
    FolderName = "O:\Customer Operations\Operational Excellence\Reporting\Niki\Payout Productivity\"
    FileName = "Payout Productivity.xlsx"
    
    On Error GoTo exitsub
'check file / folder exists
    If Not Dir(FolderName & FileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False


'open database workbook
        Set wbDatabase = Workbooks.Open(FolderName & FileName, ReadOnly:=False)
        
        With wbDatabase
            
            With .Sheets(1)
'get next empty row
                emptyrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                
'Export Data to worksheet
                .Cells(emptyrow, 1).Value = DateTextBox.Value
                .Cells(emptyrow, 2).Value = ComboBox1.Value
                .Cells(emptyrow, 3).Value = HoursWorkedTextBox.Value
                .Cells(emptyrow, 4).Value = CompleteServicePlansTextBox.Value
                .Cells(emptyrow, 5).Value = DualAssetTextBox.Value
                .Cells(emptyrow, 6).Value = ServicePanFailedTextBox.Value
                .Cells(emptyrow, 7).Value = Proofsand903sTextBox.Value
                .Cells(emptyrow, 8).Value = RenamingTextBox.Value
                .Cells(emptyrow, 9).Value = PriorityPayoutTextBox.Value
                .Cells(emptyrow, 10).Value = PayoutQueriesTextBox.Value
                .Cells(emptyrow, 11).Value = CancellationTextBox.Value
                .Cells(emptyrow, 12).Value = BackoutsTextBox.Value
                .Cells(emptyrow, 13).Value = ManualContrasTextBox.Value
                .Cells(emptyrow, 14).Value = RemitsTextBox.Value
                .Cells(emptyrow, 15).Value = FigureFixesTextBox.Value
                .Cells(emptyrow, 16).Value = SPQueriesTextBox.Value
                .Cells(emptyrow, 17).Value = SPManualLoadsTextBox.Value
                .Cells(emptyrow, 18).Value = SPInvoicesTextBox.Value
                .Cells(emptyrow, 19).Value = SPCancellationsTextBox.Value
                .Cells(emptyrow, 20).Value = RentalAmendmentsTextBox.Value
                .Cells(emptyrow, 21).Value = VDATextBox.Value
                .Cells(emptyrow, 22).Value = ICRTextBox.Value
                .Cells(emptyrow, 23).Value = FCMChequesTextBox.Value
                .Cells(emptyrow, 24).Value = NBCampaignAutorisationTextBox.Value
                .Cells(emptyrow, 25).Value = PostTextBox.Value
                .Cells(emptyrow, 26).Value = A8ManualLoadsTextBox.Value
                .Cells(emptyrow, 27).Value = A8ActivationsTextBox.Value
                .Cells(emptyrow, 28).Value = SeperatingLettersTextBox.Value
                .Cells(emptyrow, 29).Value = DeclineReportTextBox.Value
                .Cells(emptyrow, 30).Value = iLearnTextBox.Value
                .Cells(emptyrow, 31).Value = TrainingTextBox.Value
                .Cells(emptyrow, 32).Value = SupportTextBox.Value
                .Cells(emptyrow, 33).Value = GeneralLedgerTextBox.Value
                .Cells(emptyrow, 34).Value = TextBox7.Value
                .Cells(emptyrow, 35).Value = MeetingTextBox.Value
                .Cells(emptyrow, 36).Value = PDRTextBox.Value
                .Cells(emptyrow, 38).Value = OtherTextBox.Value
                .Cells(emptyrow, 37).Value = RCHPendingTextBox.Value
                .Cells(emptyrow, 39).Value = RCHChequesTextBox.Value
                .Cells(emptyrow, 40).Value = RCHBackoutsTextBox.Value
                .Cells(emptyrow, 41).Value = RCHLateLoadsTextBox.Value
                .Cells(emptyrow, 42).Value = NotesTextBox.Value
            End With
'close & save
            .Close True
        End With
'report success
        MsgBox "Record Added To Database", 48, "Record Added"
    Else
'report file not found
        MsgBox FolderName & FileName & Chr(10) & Chr(10) & "File Not Found", 48, "File Not Found"
    End If
'clear object from memory
    Set wbDatabase = Nothing
    
exitsub:
'close database if still open
If Not wbDatabase Is Nothing Then wbDatabase.Close False
Application.ScreenUpdating = True
'tell user what went wrong
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

This is untested but should give you something to work with but do come back if need further assistance.

Dave

 

[Nikijune]

Thanks Dave.

I have tried this code. It is falling at the initialize variables stage, with an error saying 'Only comments may appear after End Sub, End Function, or End Property'

I have tried removing the End Sub that appears prior to this step, and it just does nothing. I have tried removing the quotations for my file name, which it does not like. Any ideas?



Thanks - Niki

 

[dmt32]

Thanks Dave.

I have tried this code. It is falling at the initialize variables stage, with an error saying 'Only comments may appear after End Sub, End Function, or End Property'

I have tried removing the End Sub that appears prior to this step, and it just does nothing. I have tried removing the quotations for my file name, which it does not like. Any ideas?



Thanks - Niki

Although not tested, code compiled ok - Did you copy ALL the code to your workbook as published?

Dave