Submit User Form Data to another workbook - forms

I have created a User Form in VBA so that call centre staff can submit their numbers to our tracking spreadsheet at the end of each day. In its current design, the form successfully submits data to another sheet in the workbook. As I discovered, macro-enabled spreadsheets can't be shared (each staff member will submit at roughly 4pm), so I am looking at making a copy of the user form spreadsheet for each staff member (around 15) and directing it to submit to a shared spreadsheet every day.
i.e. 15 or so staff members use "User Form.xlsm" to submit to "Tracking Spreadsheet.xlsx" all around 4pm each day.
Q1: Do I need to make the "Tracking Spreadsheet.xlsx" a Shared workbook in case more than one staff member submits their end of day form at once?
Q2: Do I need to insert VBA code in "User Form.xlsm" that actively opens "Tracking Spreadhseet.xlsx" or can I just reference "Tracking Spreadhseet.xlsx"?
Q3: Where have I gone wrong in the code below? I'm new to VBA. I have structured my code for the submission button as follows, but it just adds data to the Daily_Tracking_Dataset sheet in the current workbook, rather than the new one:
First, I tried to change the workbook,
then i make the relevant sheet in the workbook active,
then I determine the first empty row,
then I transfer the information from the form's textboxes to the new workbook.
Private Sub Button_Submit_Click()
'Change Workbook
Dim nwb As Workbook
Set nwb = Workbooks.Open("G:\Tracking Spreadsheet.xlsx")
Dim emptyRow As Long
'Make Daily_Tracking_Dataset active
Daily_Tracking_Dataset.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer Information
Cells(emptyRow, 1).Value = TextBox1.Value
Cells(emptyRow, 2).Value = lstName.Value
Cells(emptyRow, 3).Value = txtROIT.Value
Cells(emptyRow, 4).Value = txtROISub.Value
Cells(emptyRow, 5).Value = txtRefsT.Value
Cells(emptyRow, 6).Value = txtRefsC.Value
Cells(emptyRow, 7).Value = txtRefsSub.Value
Cells(emptyRow, 8).Value = txtReSubT.Value
Cells(emptyRow, 9).Value = txtReSubSub.Value
End Sub

Try this sample below:
Private Sub TextBox1_afterupdate()
Dim pro As Workbook
Set pro = Workbooks.Open("F:\DOCUMENTS\Proration.xlsm")
Workbooks("proration").Sheets("sheet1").Range("i20").End(xlUp).Offset(1, 0).Value = UserForm1.TextBox1.Value
pro.Save
pro.Close True
End Sub

Regarding Q1/Q2: yes, you will need to add code to open the worksheet, and it may be better to open it Shared, at least if you do not save and close the tracking spreadsheet file immediately after inserting the data.
Did you try an Access database or something similar, where you can more easily add the required information and do not need to worry about concurrent accesses to the data "sheet"?
Regarding Q3: you did not state what is going wrong with your code at the moment.
Edit:
Regarding Q3: Try using something like nwb.Sheets( "daily_tracking_dataset" ).Cells(emptyRow, 1).Value = TextBox1.Value and be aware that emptyRow also needs to be determined using nwb, e.g. using a combination of Offset and Move(xlDown) (see Excel: Move selection to next blank row in specific column, and enumerate selection by date and type).

Thanks for the help. I ended up using the emptyrow method below:
'Begin Transfer Information and Change Workbook
Dim nwb As Workbook
Set nwb = Workbooks.Open("G:\Time To Complete Dataset.xlsx")
'Determine emptyRow
Dim emptyRow As Long
emptyRow = WorksheetFunction.CountA(nwb.Sheets("daily_tracking_dataset").Range("A:A")) + 1
'Transfer Information
With nwb.Sheets("daily_tracking_dataset")
'Datebox
.Cells(emptyRow, 1).Value = CDate(txtDate.Text)
'Listbox
.Cells(emptyRow, 2).Value = lbName.List(lbName.ListIndex)
'Textbox
.Cells(emptyRow, 3).Value = txtROT.Value
End With
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Related

Navigate programmatically through the records of a continuous form

I would like to navigate through the records of a continuous form in Access 97. I don't find how to do it. This is what I tried:
Me.RecordSetClone.MoveFirst moves to the first record logically, but not in the UI. Also the CurrentRecord property does not change.
I cannot set the CurrentRecord property, it is readonly. Me.CurrentRecord = 1 gives an error.
DoCmd.GoToRecord Record:=acFirst seems to have no effect.
What is the correct way to move to the first record in a continuous form (and to the next/previous)?
Use the Bookmark property of RecordsetClone and Form.
Caveat: I'm pretty sure all this worked in Access 97, but that was a really long time ago.
Sub DemoNavigate()
Dim RS As DAO.Recordset
Set RS = Me.RecordsetClone
RS.MoveFirst
' or
RS.AbsolutePosition = 0
' Navigate in form
Me.Bookmark = RS.Bookmark
' next record
RS.MoveNext
' or
RS.AbsolutePosition = 1
Me.Bookmark = RS.Bookmark
' Move to searched record
RS.FindFirst "someField = 42"
Me.Bookmark = RS.Bookmark
End Sub

MS Access combo box

I'm new to forms in MS access and I've created a form with a combo box that auto fills a few things i'm looking for, basically and name, phone #, and check out date. I have added another text box for "check in date" and I'm able to input the date but it will update the first record in the table that I'm pulling information from and not the record that the auto fill combo box displays. would anyone know a fix to update the record that the auto fill display versus the top record of the table?
Private Sub Combo0_Change()
Me.txtfname = Me.Combo0.Column(1)
Me.txtlname = Me.Combo0.Column(2)
Me.txtphone = Me.Combo0.Column(3)
Me.txtpump = Me.Combo0.Column(4)
Me.txtdateissue = Me.Combo0.Column(5)
Me.txtduedate = Me.Combo0.Column(6)
Me.txtCheckInDate = Me.Combo0.Column(7)
End Sub
Private Sub Combo0_Click()
End Sub
Private Sub txtCheckInDate_Change()
End Sub
get the source of Combo0 combobox, then in Private Sub txtCheckInDate_Change() function, change its source to that source + your filter, like
Me.Combo0.RowSource = "[Existing Combo Source SQL]" & _
" WHERE [YourDateField] = #" & me.txtCheckInDate & "#"

LibreOffice Draw -add hyperlinks based on query table

I am using draw to mark up a pdf format index map. So in grid 99, the text hyperlinks to map99.pdf
There are 1000's of grid cells - is there a way for a (macro) to scan for text in a sheet that is like
Text in File | Link to add
99|file:///c:/maps/map99.pdf
100|file:///c:/maps/map100.pdf
and add links to the relevant file whenever the text is found (99,100 etc).
I don't use libre much but happy to implement any programatic solution.
Ok, after using xray to drill through enumerated content, I finally have the answer. The code needs to create a text field using a cursor. Here is a complete working solution:
Sub AddLinks
Dim oDocument As Object
Dim vDescriptor, vFound
Dim numText As String, tryNumText As Integer
Dim oDrawPages, oDrawPage
Dim oField, oCurs
Dim numChanged As Integer
oDocument = ThisComponent
oDrawPages = oDocument.getDrawPages()
oDrawPage = oDrawPages.getByIndex(0)
numChanged = 0
For tryNumText = 1 to 1000
vDescriptor = oDrawPage.createSearchDescriptor
With vDescriptor
'.SearchString = "[:digit:]+" 'Patterns work in search box but not here?
.SearchString = tryNumText
End With
vFound = oDrawPage.findFirst(vDescriptor)
If Not IsNull(vFound) Then
numText = vFound.getString()
oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")
oField.Representation = numText
oField.URL = numText & ".pdf"
vFound.setString("")
oCurs = vFound.getText().createTextCursorByRange(vFound)
oCurs.getText().insertTextContent(oCurs, oField, False)
numChanged = numChanged + 1
End If
Next tryNumText
MsgBox("Added " & numChanged & " links.")
End Sub
To save relative links, go to File -> Export as PDF -> Links and check Export URLs relative to file system.
I uploaded an example file here that works. For some reason your example file is hanging on my system -- maybe it's too large.
Replacing text with links is much easier in Writer than in Draw. However Writer does not open PDF files.
There is some related code at https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=1401.

Combine multiple Excel workbooks into one [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
Update:
Enclosed below is a sample VBA code that I found on joinedupdata.com. I need help making two modifications: (1) remove the criteria that repeated header rows are deleted and (2) see if there's a way to separate the concatenated data from each Excel file by a blank row in the combined sheet that has the filename of the following table in the left-most cell.
Dim firstRowHeaders As Boolean
Dim fso As Object
Dim dir As Object
Dim filename As Variant
Dim wb As Workbook
Dim s As Sheet1
Dim thisSheet As Sheet1
Dim lastUsedRow As Range
Dim file As String
On Error GoTo ErrMsg
Application.ScreenUpdating = False
firstRowHeaders = True 'Change from True to False if there are no headers in the first row
Set fso = CreateObject("Scripting.FileSystemObject")
'PLEASE NOTE: Change <<Full path to your Excel files folder>> to the path to the folder containing your Excel files to merge
Set dir = fso.Getfolder("<<Full path to your Excel files folder>>")
Set thisSheet = ThisWorkbook.ActiveSheet
For Each filename In dir.Files
'Open the spreadsheet in ReadOnly mode
Set wb = Application.Workbooks.Open(filename, ReadOnly:=True)
'Copy the used range (i.e. cells with data) from the opened spreadsheet
If firstRowHeaders And i > 0 Then 'Only include headers from the first spreadsheet
Dim mr As Integer
mr = wb.ActiveSheet.UsedRange.Rows.Count
wb.ActiveSheet.UsedRange.Offset(1, 0).Resize(mr - 1).Copy
Else
wb.ActiveSheet.UsedRange.Copy
End If
'Paste after the last used cell in the master spreadsheet
If Application.Version < "12.0" Then 'Excel 2007 introduced more rows
Set lastUsedRow = thisSheet.Range("A65536").End(xlUp)
Else
Set lastUsedRow = thisSheet.Range("A1048576").End(xlUp)
End If
'Only offset by 1 if there are current rows with data in them
If thisSheet.UsedRange.Rows.Count > 1 Or Application.CountA(thisSheet.Rows(1)) Then
Set lastUsedRow = lastUsedRow.Offset(1, 0)
End If
lastUsedRow.PasteSpecial
Application.CutCopyMode = False
Next filename
ThisWorkbook.Save
Set wb = Nothing
#If Mac Then
'Do nothing. Closing workbooks fails on Mac for some reason
#Else
'Close the workbooks except this one
For Each filename In dir.Files
file = Right(filename, Len(filename) - InStrRev(filename, Application.PathSeparator, , 1))
Workbooks(file).Close SaveChanges:=False
Next filename
#End If
Application.ScreenUpdating = True
ErrMsg:
If Err.Number <> 0 Then
MsgBox "There was an error. Please try again. [" & Err.Description & "]"
End If
I've been trying (without much success) to find a way to merge multiple Excel spreadsheets into one. I'm using MATLAB to analyze experimental data. A dozen Excel spreadsheets go in and an equal amount come out.
Spreadsheet Structure:
The data in each Excel file is only on the first sheet (Sheet 1).
Each sheet has four columns of data (with headers) and a variable number of data rows underneath.
Each Excel file has a unique filename.
Example:
Header 1 | Header 2 | Header 3 | Header 4
1111 22222 3333 4444
11122 11223 33344 33444
etc etc etc etc
Preferred Merging Behavior:
1) Multiple Excel files are merged into one sheet on a single new spreadsheet.
2) Column headers are maintained during the merge.
3) Instead of adding each successive data set to the bottom of the previous one ("vertical" addition), it would be great if the columns could be placed side-by-side ("horizontal" addition) with a one-column break in-between.
4) The filename of each original file is placed into a row just above the first column header.
5) Preferably cross-platform (Windows/Mac OS X). However, if VBA with ActiveX is the only way to go, that's also fine.
Sample Output:
Filename1 Filename2
Header 1 | Header 2 | Header 3 | Header 4 Header 1 | Header 2 | Header 3 | ...
111 22222 33333 4444 1111 222222 44444
Data... Data... Data... Data... Data... Data... Data...
A simple loop through the workbooks in the same folder as the master workbook should suffice.
Sub collect_wb_data()
Dim wbm As Workbook, wb As Workbook
Dim fp As String, fn As String, nc As Long
'Application.ScreenUpdating = False
Set wbm = ThisWorkbook
With wbm.Worksheets("sheet1") 'set this properly to the receiving worksheet in the master workbook
fp = wbm.Path
fn = "*.xl*"
fn = Dir(fp & Chr(92) & fn)
Do While CBool(Len(fn))
If Not fn = .Parent.Name Then
Set wb = Workbooks.Open(Filename:=fp & Chr(92) & fn, _
UpdateLinks:=False, _
ReadOnly:=True)
nc = nc + 1
.Cells(1, nc) = Left(fn, InStr(1, fn, Chr(46)) - 1)
wb.Worksheets(1).Cells(1, 1).CurrentRegion.Copy Destination:=.Cells(2, nc)
wb.Close SaveChanges:=False
Set wb = Nothing
nc = .Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Column
End If
fn = Dir
Loop
'.parent.save 'Uncomment to save before finishing operation
End With
Set wbm = Nothing
Application.ScreenUpdating = True
End Sub
Oddly, there has been scant mention of just how the list of workbooks to be processed was intended to be derived. I've used a simply file mask on the same folder that the master workbook resides in but I have left it easy to change. If specific files are to be processed, a multiple list can be made from a standard File Open dialog instead. A hard-coded array of workbook names is another option.
I've left a couple of commands (e.g. screen updating disabled, saving before finishing) commented out. You might want to uncomment these once you are satisfied with the method(s).

Getting the text of all check boxes in a tabcontrol to a string

I am extremely new to all of this, and whilst I have tried searching I cant find anything that has helped me achieve what I am after.
I have a form in VB with the following:
1 x tabcontrol
10 x checkboxes which sit in various tabs on the tab control
1 x listbox
When i tick any of the check boxes, I want their text to be added to the listbox, and when I untick, their text to be taken from the listbox.
I can achieve this very easily using if statements for the changedcheck event for each checkbox but I have to do that for every single checkbox which isn't very efficient as potentially i could have 20,30 40+ check boxes. Plus if I add one at a later stage I would have to remember to add its code.
Ideally i want a method that's says: check all the checkboxes in tabcontrol if there value is true write their text to a string, if there value is false, take there text from the string. put the string in the listbox.
I started with something like this...
Dim chk As CheckBox
Dim txt As String = ""
For Each chk In TabControl1.Controls
If chk.Checked = True Then
txt = txt + chk.Text +vbCrLF
Else
txt = replace(txt, chk.text + vbCrLf, "")
End If
Next
End Sub
First problem is that the above obviously doesn't work! so any guidance there is appreciated - i put it together from reading scraps from other code.
Second problem is, i can't get my head round how the list box will be updated, as previously i was using the CheckedChanged event for each control, which if i do what i want, then there wont be a specific CheckedChanged event, as it could be any of the checkboxes (hopefully that makes sense!). I don't want to have to press a button to add the checked checkboxes to the listbox, i want it to be dynamic
any help is very much appreciated.
For your first problem add
Dim chk As Control
Dim txt As String = ""
For Each chk In TabControl1.Controls
If TypeOf chk Is CheckBox
If DirectCast(chk, CheckBox).Checked = True Then
txt = txt + chk.Text +vbCrLF
Else
txt = replace(txt, chk.text + vbCrLf, "")
End If
End If
Next
End Sub
For your second problem in CheckedChanged event you can do something like this:
Private Sub OnCheckedChanged(sender as Object, e as EventArgs) _
Handles CheckBox1.CheckedChanged
Dim chk As CheckBox = TryCast(s, CheckBox)
Dim txt as string
If c.Checked = True Then
txt = chk.Text
EndIf
End Sub