Referencing another Worksheet in VBA

[scavazo4]

I was given this project to develop a form that by a click a button will send the answers to a separate table. It currently works. The user fills out the form in "Change Order Form (sheet1)" , when finished the submit button is clicked which then sends the responses a table in "Change Order Log (sheet2)". What I need to do now, is change the location of "

Change Order Log (sheet2)​

" to another worksheet. They want me to have the form "Change Order Form (sheet1)" as a separate standard document. Every time a user downloads it and fills out the form, the responses are sent to the same "

Change Order Log (sheet2)​

" but in another worksheet that is probably stored in a sharepoint. The more I read it, it sounds like it can just be solved by creating a google survey but they are pretty strict of sticking to this method. Any help would be greatly appreciated!
Here is the current functioning code.

Private Sub CommandButton1_Click()
Dim JobNumber As Double, WorkOrder As Double, EnteredBy As String, CurrentDate As String, Requestor As String, Acceptor As String
Dim SubPSL As String, Customer As String, TypeofChange As String, ReasonForChange As String, OvertimeRequired As String
Dim TotalTime As Integer, NumberOfHourlyPersonnel As Integer, BurdenRate As Integer, Parts As String, PartsVendor As String
Dim PartsCost As Double, AdditionalCost As Double, ResponsibleForCost As String, TotalCost As Double, Notes As String
Worksheets("ChangeOrderForm").Select
JobNumber = Range("B10")
WorkOrder = Range("B11")
EnteredBy = Range("B12")
CurrentDate = Range("B13")
Requestor = Range("B14")
Acceptor = Range("B15")
SubPSL = Range("B16")
Customer = Range("B17")
TypeofChange = Range("B18")
ReasonForChange = Range("B19")
OvertimeRequired = Range("B20")
TotalTime = Range("B21")
NumberOfHourlyPersonnel = Range("B22")
BurdenRate = Range("B23")
Parts = Range("B24")
PartsVendor = Range("B25")
PartsCost = Range("B26")
AdditionalCost = Range("B27")
ResponsibleForCost = Range("B28")
Notes = Range("B29")
TotalCost = Range("B30")

Worksheets("Change Order Log").Select
Worksheets("Change Order Log").Range("A1").Select
If Worksheets("Change Order Log").Range("A1").Offset(1, 0) <> "" Then
Worksheets("Change Order Log").Range("A1").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = JobNumber
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = WorkOrder
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = EnteredBy
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = CurrentDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Requestor
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Acceptor
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = SubPSL
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Customer
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TypeofChange
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ReasonForChange
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = OvertimeRequired
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TotalTime
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = NumberOfHourlyPersonnel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = BurdenRate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Parts
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = PartsVendor
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = PartsCost
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = AdditionalCost
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ResponsibleForCost
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TotalCost
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Notes
ActiveCell.Offset(0, 1).Select
Worksheets("ChangeOrderForm").Select
Worksheets("ChangeOrderForm").Range("B10:B29").ClearContents
End Sub
Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

 

[dmt32]

Hi welcome to forum
It is possible to send the data from one workbook to another on your network although I am not sure how you would do this for files that are placed In Sharepoint.

Let’s assume that you are using a network drive on your company local access network (LAN) then try following & see if helps you.

1 – make a copy of the Change Order Log worksheet & save it in a shared (public) folder on your network with filename Change Order Log.xlsx & close file

2 – Place following updated code in worksheet ChangeOrderForm code page.

 Private Sub CommandButton1_Click()    
    Dim DataEntryRange As Range, NextRecord As Range
    Dim FileName As String, FilePath As String, DatabaseOpenPassword As String
    Dim wbDatabase As Workbook
    Dim EntryArr As Variant
    
'*****************************************************************************************************
'***********************************************SETTINGS**********************************************
'specify file path
    FilePath = "C:\MyFolder\"
'specify file name
    FileName = "Change Order Log.xlsx"
'specify password to open database workbook (optional)
    DatabaseOpenPassword = ""
    
'*****************************************************************************************************
    
    On Error GoTo myerror
    
'data entry range
    Set DataEntryRange = Me.Range("B10:B30")
'pass entry values to array
    EntryArr = DataEntryRange.Value
'check filepath / filename exists
    If Not Dir(FilePath & FileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
'open workbook
        Set wbDatabase = Workbooks.Open(FilePath & FileName, False, False, , DatabaseOpenPassword)
'get next blank row in range
        Set NextRecord = wbDatabase.Worksheets(1).Range("A1").End(xlDown).Offset(1, 0)
'post array to range
        NextRecord.Resize(1, UBound(EntryArr, 1)).Value = Application.Transpose(EntryArr)
'clear data entry range
        DataEntryRange.ClearContents
           
    Else
'file not found
        Err.Raise 53
        
    End If
    
myerror:
    If Not wbDatabase Is Nothing Then wbDatabase.Close IIf(Err = 0, True, False)
    Application.ScreenUpdating = True
    If Err <> 0 Then
'report errors
        MsgBox (Error(Err)), 48, "Error"
    Else
'report success
        MsgBox "Record Submitted", 48, "Record Submitted"
    End If
    
End Sub

You will need to update the settings values shown in code as required.

What this should do is allow your users who have network access, to write the data from their copy of the ChangeOrderForm workbook, to what is now like a “database” workbook on your corporate network.

You should note though that you CANNOT have the Change Order Log workbook open in Read / Write mode whilst users need to write data to it.

If the file is to be placed in SharePoint folder then you will need to seek guidance how to do this from others here.

Hope Helpful

Dave

 

[scavazo4]

Hey Dave,

Thank you for the quick response/solution. I copied that exact code and changed the filepath and filename. However, when I run it I get an error "File not found". I double checked the locations and even used the exact string and searched for the documents on my computer and they directed me to the files and location. What other reason could it be?

Thanks,
Sebastian

 

[xenou]

Hi, the most obvious answer is that something is wrong with your file names or paths (notwithstanding that you are sure you have not done anything wrong with these). You should post the relevant code to make it clear what you are doing.

 

[scavazo4]

Alright so I was forgetting a backslash at the end of the filepath. The error went away. Once I complete filling out B10:B30, a message box appears saying "Record Submitted". However when I go to the other document or filename the database is empty. Does it take a while for the submissions to reflect in the "database"?

Here is the code...

Private Sub CommandButton1_Click()
Dim DataEntryRange As Range, NextRecord As Range
Dim FileName As String, FilePath As String, DatabaseOpenPassword As String
Dim wbDatabase As Workbook
Dim EntryArr As Variant

'*****************************************************************************************************
'***********************************************SETTINGS**********************************************
'specify file path
FilePath = "C:\Users\H236252\Desktop\Sebastian Cavazos\COS Project1"
'specify file name
FileName = "COHistoryLog.xlsm"
'specify password to open database workbook (optional)
DatabaseOpenPassword = "password"

'*****************************************************************************************************

On Error GoTo myerror

'data entry range
Set DataEntryRange = Me.Range("B10:B30")
'pass entry values to array
EntryArr = DataEntryRange.Value
'check filepath / filename exists
If Not Dir(FilePath & FileName, vbDirectory) = vbNullString Then
Application.ScreenUpdating = False
'open workbook
Set wbDatabase = Workbooks.Open(FilePath & FileName, False, False, , DatabaseOpenPassword)
'get next blank row in range
Set NextRecord = wbDatabase.Worksheets(1).Range("A1").End(xlDown).Offset(1, 0)
'post array to range
NextRecord.Resize(1, UBound(EntryArr, 1)).Value = Application.Transpose(EntryArr)
'clear data entry range
DataEntryRange.ClearContents
Else
'file not found
Err.Raise 53

End If

myerror:
If Not wbDatabase Is Nothing Then wbDatabase.Close IIf(Err = 0, True, False)
Application.ScreenUpdating = True
If Err <> 0 Then
'report errors
MsgBox (Error(Err)), 48, "Error"
Else
'report success
MsgBox "Record Submitted", 48, "Record Submitted"
End If

End Sub

 

[dmt32]

Hey Dave,

Thank you for the quick response/solution. I copied that exact code and changed the filepath and filename. However, when I run it I get an error "File not found". I double checked the locations and even used the exact string and searched for the documents on my computer and they directed me to the files and location. What other reason could it be?

Thanks,
Sebastian

filepath you have entered is missing backslash shown in RED

FilePath = "C:\Users\H236252\Desktop\Sebastian Cavazos\COS Project1\"

Dave

 

[dmt32]

Alright so I was forgetting a backslash at the end of the filepath. The error went away. Once I complete filling out B10:B30, a message box appears saying "Record Submitted". However when I go to the other document or filename the database is empty. Does it take a while for the submissions to reflect in the "database"?

The template record is posted to sheet one of the master (database workbook) - does this sheet have any existing data or is it blank?

Dave

 

[scavazo4]

It is a table with headings. A1:V1 is the title for each response. Therefore every row (starting r2) should signify a submission.

-Sebastian Cavazos

 

[scavazo4]

Alright so it seems like the responses are being stored in the heading of each column in the table. Thus making the submissions begin in row 2 would solve this issue. Also is there a way for cell B30 to stay intact after each submission. That is B10:B29 clears after every submission, but the format in B30 stays the same? B30 contains a formula which gathers the summation of several cells above.

 

[xenou]

This will fail if the "database worksheet" is empty or only has a header row:

Set NextRecord = wbDatabase.Worksheets(1).Range("A1").End(xlDown).Offset(1, 0)

The problem is that end(XlDown) will take you all the way to the bottom of the spreadsheet (such as row 1048576) and then offset(1,0) will crash.

It also will have problem if (or when ... murphy's law) there is a blank row in the data rows.

Better would be:

Set NextRecord = wbDatabase.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

That is ... start at the bottom and find the last row going up from there.