Standard entry from another worksheet

[bartmanekul]

I just need a pointer for this one.

Tried googling, but think I'm putting the wrong terms in.


I have a template spreadsheet, which people use for scoring.

This data needs to go into a table, and although I've made it as easy as possible - set it up so they only have to copy and paste a single line into the data table, I'd still much rather not have them in the table in the first place.

So first:

Is it possible to include a button for them to press on this template sheet which will add the results to a new row in a data table in another spreadsheet?

If so, how do I do this? I've never touched VBA, though if there's existing code I can likely modify to my needs.

Again, if possible, is there anything that can be done to stop someone from adding an entry twice (i.e. they press the button again)?

Thanks in advance.

 

[bartmanekul]

That is flaming brilliant, thank you very much. I've never even created a module (in truth I've never touched anything in the developer tab), but all works brilliantly.

If I had any word for improvement, it's that instead of clearing all fields, it'd only clear one (which would be a mandatory field unlike the others).

Much appreciated, this will make life an awful lot easier.

 

[dmt32]

That is flaming brilliant, thank you very much. I've never even created a module (in truth I've never touched anything in the developer tab), but all works brilliantly.

If I had any word for improvement, it's that instead of clearing all fields, it'd only clear one (which would be a mandatory field unlike the others).

Much appreciated, this will make life an awful lot easier.

Hi,
it's amazing what you can do with excel.

I have neglected to mention that when templates are in use, the Database workbook MUST NOT be opened by you in read / write mode otherwise, users will not be able to submit data. You can open a copy read only if needed.
In normal use, you should not get any conflicts (users submitting data at same time) but let me know if this becomes & issue - I have a function to manage this. Users can however, leave their templates open all day if want to.

Also, in the BrowseFile function change the number (shown) in bold to 2
Its always way when you chop code around that you over look the minor things - setting this to 2 will make xlsx files default in selection.
I have spotted one or two other minor issues but don't think they will cause you any problems.

Application.GetOpenFilename(sFilter, 1, "Select Database Workbook")

Finally, the code is dynamic & can be used with any other templates you have a similar requirement for.

Glad solution helped & appreciate the feedback

Dave

 

[bartmanekul]

I'd already spotted the default it was going to, thanks for the heads up.

I do have one question - it's putting a date field in the wrong way around.

Put in todays date - 15/05/2017, but in the data table it's 5/15/2017. While the source and destination is both set to short date, I notice the cell it's populated in the data table is now custom, m/d/yyyy.

Since it seems to be the correct date but just in different format, I assume this won't affect any reporting?

 

[dmt32]

Hi,
I have made some other tweaks including hopefully, fixing date issue - replace both codes with following & see if resolves:

Sub SaveTemplateData()
'dmt32 - May 2017
    Dim DatabasePassword As String, TemplateSheet As String
    Dim wbDatabase As Workbook, wbTemplate As Workbook
    Dim DatabaseRange As Range, DataEntryRange As Range, Item As Range
    Dim DatabaseName As Variant, msg As Variant, Data() As Variant
    Dim i As Integer, InputCellCount As Integer
    Dim CompleteAllCells As Boolean
    
'**********************************************************************************************
'*******************************************SETTINGS*******************************************


'Database workbook open password - enter as required (case sensitive)
    DatabasePassword = ""
'Template Input Addresses
'cells can be both contiguous & non-contiguous
    TemplateInputAddress = "B118:BM118"
'data entry rules (Set True if ALL Cells must be completed)
    CompleteAllCells = False
    
'**********************************************************************************************


'Database Path / Name
    DatabaseName = Cells(Rows.Count, 1).Value


    If Len(DatabaseName) = 0 Then
        DatabaseName = BrowseFile
        If DatabaseName = False Then Exit Sub
        Cells(Rows.Count, 1).Value = DatabaseName
    End If


    On Error GoTo myerror
'check file / folder path valid
    If Not Dir(DatabaseName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
        Set wbTemplate = ThisWorkbook
        
'data entry range
        Set DataEntryRange = wbTemplate.Worksheets(1).Range(TemplateInputAddress)
           
'count No Input Cells
    InputCellCount = DataEntryRange.Cells.Count
    
    For Each Item In DataEntryRange.Cells
'check if required entry for all cells
        If CompleteAllCells And Len(Item.Value) = 0 Then
            MsgBox "Please Complete All Fields.", 16, "Entry Required"
            Item.Select
            Exit Sub
        End If
'build array
        i = i + 1
        ReDim Preserve Data(1 To i)
'data values to array
    If IsDate(Item.Text) Then
        Data(i) = DateValue(Item.Text)
    Else
        Data(i) = Item.Value
    End If
    Next Item
    
'or if some blank cells allowed, check if any data entered
    If Not CompleteAllCells And Application.CountA(Range(TemplateInputAddress)) = 0 Then
        MsgBox "All Fields Are Empty.", 16, "Error"
    Exit Sub
    End If
    
'Open database
        Set wbDatabase = Workbooks.Open(DatabaseName, ReadOnly:=False, Password:=DatabasePassword)
        
'Next empty range in database
        With wbDatabase.Sheets(1)
            Set DatabaseRange = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
        End With


'output array to database range
        DatabaseRange.Resize(1, InputCellCount).Value = Data
'close & save
        wbDatabase.Close True
'clear form
        DataEntryRange.ClearContents
'report success
        msg = Array("Template Data Saved", "Data Saved")
    Else
'report problem
        msg = Array(DatabaseName & Chr(10) & "File Not Found", "Error")
    End If
    
myerror:
    Application.ScreenUpdating = True
    If Err > 0 Then
        If Not wbDatabase Is Nothing Then wbDatabase.Close False
        MsgBox (Error(Err)), 48, "Error"
    Else
        MsgBox msg(0), 48, msg(1)
    End If
'clean up
    Set wbDatabase = Nothing
    Set wbTemplate = Nothing
    Set DataEntryRange = Nothing
End Sub

Function BrowseFile() As Variant
'dmt32 - May 2017
    Dim sFilter As String


    sFilter = "Worksheets 2003 (*.xls),*.xls," & _
              "Worksheets 2007 > (*.xlsx),*.xlsx," & _
              "All Excel Files (*.xl*),*.xl*," & _
              "All Files (*.*),*.*"


    BrowseFile = Application.GetOpenFilename(sFilter, 2, "Select Database Workbook")
End Function

Dave

 

[bartmanekul]

Fantastic stuff, thank you again. I've already used it for 4 workbooks.

 

[dmt32]

Fantastic stuff, thank you again. I've already used it for 4 workbooks.

Hi,
glad solution helped. Appreciate feedback

Dave

 

[bartmanekul]

Interestingly, anything past decimal place gets uploaded as time. Any way I can tweak the code to tell it not to?

I.e. an entry of 0.5 goes in as 12:00 time format. No matter the formatting of the cell it's in (entry or destination).

 

[dmt32]

Interestingly, anything past decimal place gets uploaded as time. Any way I can tweak the code to tell it not to?

I.e. an entry of 0.5 goes in as 12:00 time format. No matter the formatting of the cell it's in (entry or destination).

I suspect IsDate Function thinks its a time value

Don't have lot of time at moment - see if this clumsy fix solves the problem:

   If Len(Item.Text) = 10 And IsDate(Item.Text) Then
        Data(i) = DateValue(Item.Text)
    Else
        Data(i) = Item.Value
    End If

this assumes your date format is dd/mm/yyyy

Dave

 

[bartmanekul]

Thanks, that solved the problem!

Sorry for delay in response, it was a while before I could implement it.

 

[bartmanekul]

Question for anyone looking at this, how would I 'reset' the upload location?

So if the table it's going into changes location, I only get an error and can't choose where to locate it.