Copy textbox data on userform to spreadsheet in another workbook

rgwood

New Member
Joined
Jul 13, 2018
Messages
2
Hi all,

I am currently using the following code transfer data from text boxes on a userform to a spreadsheet in the same workbook.

What I need to happen is for users to all have their own individual copies of the userform which they would have on their desktops, but for the data to be transferred to a spreadsheet that ideally doesn't open or can be manually edited on a shared drive. Essentially, as each data is entered I want it to go to the centrally stored spreadsheet and if requests come in at a similar time, for both entries to still appear even if they are queued somehow rather than overwriting someone elses entry.

This is what I have...any pointers would be appreciated:

Code:
Private Sub Userformtotable()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    With ws
        .Cells(lRow, 1).Value = Me.cboFix.Value
        .Cells(lRow, 2).Value = Me.Com.Value
        .Cells(lRow, 3).Value = Me.Dom.Value
        .Cells(lRow, 4).Value = Me.KO.Value
        .Cells(lRow, 5).Value = Me.DO.Value
        .Cells(lRow, 6).Value = Me.cboCRef.Value
        .Cells(lRow, 7).Value = Me.AHolder.Value
        .Cells(lRow, 8).Value = Me.AHEmail.Value
        .Cells(lRow, 9).Value = Me.Organisation.Value
        .Cells(lRow, 10).Value = Me.RBy.Value
        .Cells(lRow, 11).Value = Me.RByEmail.Value
        .Cells(lRow, 12).Value = Me.CN.Value
        .Cells(lRow, 13).Value = Me.CE.Value
        .Cells(lRow, 14).Value = Me.User.Value
        .Cells(lRow, 15).Value = Me.NowStamp.Value
    End With
       
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi all,

What I need to happen is for users to all have their own individual copies of the userform which they would have on their desktops, but for the data to be transferred to a spreadsheet that ideally doesn't open or can be manually edited on a shared drive. Essentially, as each data is entered I want it to go to the centrally stored spreadsheet and if requests come in at a similar time, for both entries to still appear even if they are queued somehow rather than overwriting someone elses entry.


Hi,
try this update to your code & see if helps

Rich (BB code):
Private Sub Userformtotable_Click()
    
    Dim FileName As String, OpenPassword As String
    Dim lRow As Long
    Dim wbDatabase As Workbook
    
'define file path \ name
    FileName = "c:\myfolder\database.xlsx"
'workbook open password
    OpenPassword = "" '<< Enter password as required
    
'confirm folder \ filename valid
    If Not Dir(FileName, vbDirectory) = vbNullString Then
    
'open workbook
    On Error GoTo myerror
    Application.ScreenUpdating = False
    Set wbDatabase = Workbooks.Open(FileName, ReadOnly:=False, Password:=OpenPassword)
    
'Copy input values to sheet.
    With wbDatabase.Worksheets(1)
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        .Cells(lRow, 1).Value = Me.cboFix.Value
        .Cells(lRow, 2).Value = Me.Com.Value
        .Cells(lRow, 3).Value = Me.Dom.Value
        .Cells(lRow, 4).Value = Me.KO.Value
        .Cells(lRow, 5).Value = Me.DO.Value
        .Cells(lRow, 6).Value = Me.cboCRef.Value
        .Cells(lRow, 7).Value = Me.AHolder.Value
        .Cells(lRow, 8).Value = Me.AHEmail.Value
        .Cells(lRow, 9).Value = Me.Organisation.Value
        .Cells(lRow, 10).Value = Me.RBy.Value
        .Cells(lRow, 11).Value = Me.RByEmail.Value
        .Cells(lRow, 12).Value = Me.CN.Value
        .Cells(lRow, 13).Value = Me.CE.Value
        .Cells(lRow, 14).Value = Me.User.Value
        .Cells(lRow, 15).Value = Me.NowStamp.Value
    End With
'close & save
    wbDatabase.Close True
    Set wbDatabase = Nothing
    
    Else
'inform user not found
        MsgBox FileName & Chr(10) & "File \ Folder Not Found", 48, "Not Found"
        Exit Sub
    End If
    
myerror:
'enusre workbook closed
    If Not wbDatabase Is Nothing Then wbDatabase.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then
'report errors
        MsgBox (Error(Err)), 48, "Error"
    Else
'file saved
        MsgBox "Record Saved.", 64, "Record Saved"
     End If
End Sub

Change File Path \ File Name shown in RED as required.

It is assumed that your master (database) workbook will be a standard non macro workbook (xlsx) containing one sheet.

It is also important to understand that whilst users need to write data, the master (database) workbook can only be opened READ only if require to view it.

Unless there is a large user base making data entries, it is unlikely that you will get conflicts but additional code can be be added should this be a problem.


Dave
 
Last edited:
Upvote 0
Hi,
try this update to your code & see if helps

Rich (BB code):
Private Sub Userformtotable_Click()
   
    Dim FileName As String, OpenPassword As String
    Dim lRow As Long
    Dim wbDatabase As Workbook
   
'define file path \ name
    FileName = "c:\myfolder\database.xlsx"
'workbook open password
    OpenPassword = "" '<< Enter password as required
   
'confirm folder \ filename valid
    If Not Dir(FileName, vbDirectory) = vbNullString Then
   
'open workbook
    On Error GoTo myerror
    Application.ScreenUpdating = False
    Set wbDatabase = Workbooks.Open(FileName, ReadOnly:=False, Password:=OpenPassword)
   
'Copy input values to sheet.
    With wbDatabase.Worksheets(1)
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        .Cells(lRow, 1).Value = Me.cboFix.Value
        .Cells(lRow, 2).Value = Me.Com.Value
        .Cells(lRow, 3).Value = Me.Dom.Value
        .Cells(lRow, 4).Value = Me.KO.Value
        .Cells(lRow, 5).Value = Me.DO.Value
        .Cells(lRow, 6).Value = Me.cboCRef.Value
        .Cells(lRow, 7).Value = Me.AHolder.Value
        .Cells(lRow, 8).Value = Me.AHEmail.Value
        .Cells(lRow, 9).Value = Me.Organisation.Value
        .Cells(lRow, 10).Value = Me.RBy.Value
        .Cells(lRow, 11).Value = Me.RByEmail.Value
        .Cells(lRow, 12).Value = Me.CN.Value
        .Cells(lRow, 13).Value = Me.CE.Value
        .Cells(lRow, 14).Value = Me.User.Value
        .Cells(lRow, 15).Value = Me.NowStamp.Value
    End With
'close & save
    wbDatabase.Close True
    Set wbDatabase = Nothing
   
    Else
'inform user not found
        MsgBox FileName & Chr(10) & "File \ Folder Not Found", 48, "Not Found"
        Exit Sub
    End If
   
myerror:
'enusre workbook closed
    If Not wbDatabase Is Nothing Then wbDatabase.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then
'report errors
        MsgBox (Error(Err)), 48, "Error"
    Else
'file saved
        MsgBox "Record Saved.", 64, "Record Saved"
     End If
End Sub

Change File Path \ File Name shown in RED as required.

It is assumed that your master (database) workbook will be a standard non macro workbook (xlsx) containing one sheet.

It is also important to understand that whilst users need to write data, the master (database) workbook can only be opened READ only if require to view it.

Unless there is a large user base making data entries, it is unlikely that you will get conflicts but additional code can be be added should this be a problem.


Dave

Dave,

I just joined this form so that I could post this message and say THANK YOU for this code. This was a huge help to me and the changes I had to make to it were very minimal. :)
 
Upvote 0
Dave,

I just joined this form so that I could post this message and say THANK YOU for this code. This was a huge help to me and the changes I had to make to it were very minimal. :)

Hi,
welcome to the forum & many thanks for your kind feedback - something all contributors here appreciate very much.

Dave
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,262
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top