Looking for a new method to create 'check-in' and 'check-out' system - vba

I am currently working on a database for a small building with a large number of HDDs and the system I have made so far works exactly as my employer desires it to.
My current problem is with some VBA coding using macros to sign in and sign out each hard drive, the hard drives have a row each with a 'check in' and 'check out' button at the end. At current moment the coding works for both of these buttons but I have to write out the code for every single button both 'check in' and 'check out'.
Is there a way to convert the location of the button into a string which would then add itself into the coding and I can put in some sort of array that will auto locate the output of each button for me?
The macro is a simple .Show statement.
My excel sheet is illustrated below. Most of the current cells are programmed with formulas as this system needs to be fairly automated for the less skilled computer users.
Edit:
After clicking the button my initials are added to the end of current time/date. This needs to happen for many buttons all results being in different cells.

My recommendation would be to avoid using a button, and instead override the SelectionChanged event handler for the worksheet. Change the buttons to formatted cells, which when clicked will perform the action you desire.
First, configure your UserForm to return a value. One way to do this is by placing the following code into the code-behind for the UserForm:
Public Property Get Initials() As String
Initials = txtInitials.Text
End Property
Public Property Let Initials(ByVal sInitials As String)
txtInitials.Text = sInitials
End Property
Private Sub btnOk_Click()
Me.Hide
End Sub
Next, add the following code to Sheet1:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sInitials As String
Dim sDate As String
Dim sTime As String
Dim frmInitials As InitialsForm
If Target.Column = 13 Then
Set frmInitials = New InitialsForm
frmInitials.Show
sInitials = frmInitials.Initials
Unload frmInitials
sDate = Date
sTime = Time
Cells(Target.Row, 6).Value = sDate + " / " + sTime + " " + sInitials
End If
End Sub
When the user clicks on a cell in column 13 (M - "Check Out"), a userform will be displayed asking for the user's initials. Once they have entered them and pressed the OK button, the initials will be added to the end of the timestamp and inserted into column 6 (F) of the same row.

Related

VBA: ComboBox only showing one item after Workbook_Open event

I am attempting to have a Workbook_Open event populate a controls ComboBox
so that when the user goes to the Worksheet("Benchmarking"), they have a pre-populated list to choose from that includes all the items in the array datesArr.
The problem i am having is, upon opening the spreadsheet and navigating to the Worksheet("Benchmarking"), i am only seeing one item in the drop down list:
If i select that item then the list actually populates:
Desired result:
I want the full list to be available from the first time the user tries to make a selection not just after the ComboBox1_Change event is fired.
Having reviewed numerous post e.g. Sometimes the ActiveX Combobox only shows one row, why? , Populating Combo Box on WorkBook Open I have tried several different approaches including the following in the Workbook_Open event code:
.ListFillRange = "DropDownDates"
.List = DateArrToStrAr
I have also looped the array adding the items to ComboBox1. Each time i get the same 1 visible item in drop down result.
Is someone able to tell me where i am going wrong please?
My current code is
1) ThisWorkbook
Private Sub Workbook_Open()
With Worksheets("Benchmarking").OLEObjects("ComboBox1").Object
.Clear
.List = DateArrToStrArr '
End With
End Sub
2) Worksheet("Benchmarking"):
Private Sub ComboBox1_Change() 'QH 2/11/17
Dim datesArr() As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Lkup")
datesArr = DateArrToStrArr 'function that reads a named range of dates and converts to string to avoid dd/mm becoming mm/dd
If ComboBox1.Value = vbNullString Then ComboBox1.Value = "01/04/2016"
ComboBox1.List = datesArr
'.....other code
End Sub
Notes:
The array datesArr is populated by the function DateArrToStrArr() which reads in a named range of dates "DropDownDates" (workbook scope) and converts them to a string array. This is then assigned to the ComboBox.
DropDownDates is a dynamic named range with formula =OFFSET(Lkup!$F$16,,,Lkup!$M$12,)
Set-up: Excel 2016 64 bit Windows.
Thanks to #CLR for making me think about recalcs. I decided to hack my way around this with the following:
I have added in Worksheet("Benchmarking") a Worksheet_Activate event and removed the Workbook_Open code. This seems to do the trick
Private Sub Worksheet_Activate()
' ComboBox1.Clear
ComboBox1.List = DateArrToStrArr
End Sub

Automatically updating a userform label

I'm new to VBA and programming in general, so bear with me. I have so far 6 labels, and a simple useform where one enters a value corresponding to each label. However, the label name can change (say if new labels are added) and I wanted a way to automatically change the label name. This is what I have so far:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Update_invest.Invest1.Caption = Sheet1.Range("A12").Value
Update_invest.Invest2.Caption = Sheet1.Range("A13").Value
Update_invest.Invest3.Caption = Sheet1.Range("A14").Value
Update_invest.Invest4.Caption = Sheet1.Range("A15").Value
Update_invest.Invest5.Caption = Sheet1.Range("A16").Value
Update_invest.Invest6.Caption = Sheet1.Range("A17").Value
End Sub
Now this works: if I change a label it will update the userform. However, if I just open the new worksheet and don't click on say cell A12, it will not update the userform and will leave the label name as it's default name. How do I make it actually save the label name, so that if a user opens the workbook the userform will already have the current cell value (without first having to click on the cell for the userform to update)?
I have this code currently on sheet1.
Solution 1
You can put your code in Worksheet_Activate which is run when the user select the sheet or in Workbook_Open which is run when the user open the workbook. Currently, your are using Worksheet_SelectionChange which is only run when the user change the selection, hence the need to click on another cell.
NOTE : if you chose to use Workbook_Open, you will need to put the sub in the ThisWorkbook file and not in the worksheet itself.
Solution 2
If you instead want to make the changes permanant and not have code to always update it, you will need to go through the designer
Here is an exemple
Sub exa1()
Dim i As Long, n As Long
n = 12
With ThisWorkbook.VBProject.VBComponents("Update_invest").Designer
For i = 1 To .Controls.Count
If TypeName(.Controls(i - 1)) = "Label" Then
.Controls(i - 1).Caption = Sheet1.Cells(n, 1).Value
n = n + 1
End If
Next i
End With
End Sub
source

VBA - Excel Showing form after double click on a Cell

I've encountered a strange Problem. I have an Input Form for the User in Excel.
This Form provides basic CRUD functions to edit a List in a Table. Now this Userform also has a ListBox which shows all the entrys with Id and some basic infos (so you know which entry is which ). Now what I want is, that if you select a row in the normal excel table, and then open the InputForm, the selected row in the table should also be selected in the listBox of the InputForm.
I do this like this:
If Selection.Row >= StartRow() Then
ListBoxAll.listIndex = Selection.Row - StartRow()
Else
ListBoxAll.listIndex = 0
End If
This works great if I open the Ui per Button click. But if I try to open the form with the Before Double Click Event. I got an Offset.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
UserFormInput.Show
End Sub
Now for the strange part. If I check what value the Selection.Row has, by showing it with a MessageBox, it all works fine! But as soon as I remove the MessageBox its broken all over again.
If Selection.Row >= StartRow() Then
ListBoxAll.listIndex = Selection.Row - StartRow()
MsgBox Selection.Row
Else
ListBoxAll.listIndex = 0
End If
It does not matter where in the if I put the Messagebox.
So the Question has anybody ever got the same Problem ? And does anybody know a solution or a workaround to it ? (I don't want to show a Messagebox!)
So I added some screenshots to make it easier to understand.
Update I think it has something to do with the Focus after a double click, which is (maybe) on the doubleclicked Cell. And gets changed if I put out a MsgBox
(I'll write this as an answer but this is only a part of the code... :)
Oh, german ^.^
I believe each time you call your userform you'll have to compare the selected data to the listbox data. As you have a multicolumn listbox you could do this by the following (I believe, but untested):
Dim ThisRow As Integer
ThisRow = ActiveCell.Row
Dim ThisValue As String
ThisValue = ActiveWorkbook.Sheet("Tabelle1").Cells(ThisRow, 1).Value
This "1" should be the column which contains the same kind of information as is displayed in the first column of your listbox.
Dim i As Integer
For i = 1 to UserFormInput.Listbox1.Listcount
If UserFormInput.Listbox1.List(i, 0).Value = ThisValue Then
UserFormInput.Listbox1.List(i).Select
End If
Next i

Is there a way to have a scrollable list that is editable?

Following this video I have a spreadsheet that has a "Edit History" box on it that scrolls up and down. It uses a forms control scroll box and a list on a secondary sheet to create a scrollable list. The problem with this is that you cannot then edit the information in the scroll box (you must edit it on the secondary sheet).
I have VBA that automatically enters the person's name into the scrollbox when they edit any part of the sheet, and then enters "Note:" below that. I want the person to be able to edit the "Note:" box so that they can enter the reason they are editing the sheet:
John Smith and James Appleseed are previous users of this sheet. When Wayne Smith comes in to edit the sheet, as soon as he makes a change, it adds "Wayne Smith" and "Note:" to the sheet. (I already have this part working using VBA).
Because of the way that the scroll able list is implemented, it is actually all just formulas within this edit history box. If I double click "Note:" to try and edit it, this is what appears:
But what I want to happen is the ability to edit the "Note:" box (without having to switch to the secondary sheet where the list is actually stored). Essentially I want to make a scroll able text box that is also directly editable, and works with VBA.
Is there any way to do this?
I put together a working example of how to do this.
You can download the workbook here.
This method uses two sheets in a workbook... Sheet1 for the listbox and listboxdata for the data. Sheet1 can be called anything you like.
It would probably be wise to hide the listboxdata sheet.
On Sheet1 you need a Forms Control scrollbar. Use the Name Box to rename it: ScrollBar1. Assign to it the Scroll() procedure.
All of the code for this app should be placed in the Sheet1 code module:
Option Explicit
Private Const LISTBOX_SCROLLBAR = "scrollbar1"
Private Const LISTBOX_DATASHEET = "listboxdata"
Private Const LISTBOX_DATAHEADR = "a1"
Private Const LISTBOX_SCROLLMAX = 50
Private Const LISTBOX_SCROLLMIN = 1
Private Sub Scroll()
Dim ListBoxRows&, n&, ndx&, v
On Error Resume Next
With Shapes(LISTBOX_SCROLLBAR)
SetProps ndx
ListBoxRows = .BottomRightCell.Row - .TopLeftCell.Row
v = ThisWorkbook.Sheets(LISTBOX_DATASHEET).Range(LISTBOX_DATAHEADR).Resize(ListBoxRows).Offset(ndx)
Application.EnableEvents = False
.TopLeftCell(, 0).Resize(ListBoxRows) = v
End With
Application.EnableEvents = True
End Sub
Private Sub Update(Target As Range)
With Shapes(LISTBOX_SCROLLBAR)
If Target.Column = .TopLeftCell(, 0).Column Then
If Target.Row >= .TopLeftCell.Row And Target.Row <= .BottomRightCell.Row Then
If Target.Count = 1 Then
ThisWorkbook.Sheets(LISTBOX_DATASHEET).Range(LISTBOX_DATAHEADR).Offset(.ControlFormat.Value + Target.Row - .TopLeftCell.Row) = Target
Else
Scroll
End If
End If
End If
End With
End Sub
Private Sub SetProps(Optional ndx&)
With Shapes(LISTBOX_SCROLLBAR).ControlFormat
.Min = LISTBOX_SCROLLMIN
.Max = LISTBOX_SCROLLMAX
ndx = .Value
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Update Target
End Sub
Private Sub Worksheet_Activate()
SetProps
End Sub
That's it.
No formulas required in the listbox and any changes made to the cells in the listbox will be written to the source data and kept.

What VBA coding in a Userform can I use to find a cell based upon row & column content, and then update that cell?

I am a complete beginner to VBA, truely.
I am trying to create a user form that will update the number of tasks a person completes on a given date as listed on a spreadsheet. I envision the Userform having two bottons (which are hidden and appear as the conditions of the subroutine). I am working on a Mac, by the way, and I know that will have VBA coding implications for use on a PC och vice versa.
The example sheet is this:
The example Userform (a) is this:
For argument's sake, let say I want to update or input the number of tasks that Greg completed on the 7th of May (2013/05/07).
I would like for the Userform to proceed something like this:
Entering person and date:
Then, retrieving number of tasks for Greg on the 7th after button click:
Now, I want to input that I know Greg completed 6 tasks on the 7th and I click the second button (now visible and the first button hidden):
And the result in the spreadsheet:
I ought to input some code here, but my skills and the completeness of the code are wanting. But I will put in what I have:
Option Explicit
'Subroutine when clicking the first ("find") button
Private Sub btnfind_Click()
lbltasks.Vissible = True
txttasks.Visible = True
btnupdate.Visible = True
btnfind.Visible = False
'Defining variables
Dim pr01 As String
Dim dt01 As Date
Dim tsk01 As Integer
'Assigning variables to inputs
pr01 = txtperson.Text
dt01 = txtdate.Text
tsk01 = txttask.Text
'Looking for Name in column "A"
' ? ? ?
'Looking for inut Date in row "1"
' ? ? ?
'Retrieving the existing number of tasks according to name and date
'and showing number in the 'tasks' text input box in the user form
' ? ? ?
End Sub
'Subroutine when clicking the Second ("update") button
Private Sub btnupdate_Click()
'Paste updated Number of tasks in appropriate cells according to name and date
'The new number of tasks should over write what was there previously
' ? ? ?
End Sub
Thanks in advance for any and all help!
This should work. Please study it and use the macro record function in Excel to grasp a lot more:
Option Explicit
Public frmName As Variant 'store row of name
Public frmDate As Variant 'store column of date
'Subroutine when clicking the first ("find") button
Private Sub btnfind_Click()
'Defining variables
Dim pr01 As String
Dim dt01 As Date
Dim tsk01 As Integer
'Assigning variables to inputs
pr01 = UserForm1.TextBox1.Text
dt01 = UserForm1.TextBox2.Text
tsk01 = UserForm1.TextBox3.Text
'Looking for Name in column "A"
With ThisWorkbook.Worksheets("Sheet4")
frmName = .Columns("A").Find(pr01).Row
End With
'Looking for inut Date in row "1"
With ThisWorkbook.Worksheets("Sheet4")
frmDate = .Rows(1).Find(CDate(dt01)).Column
End With
If frmName Is Nothing Or frmDate Is Nothing Then
'not found
Exit Sub
End If
'Retrieving the existing number of tasks according to name and date
'and showing number in the 'tasks' text input box in the user form
With ThisWorkbook.Worksheets("Sheet4")
UserForm1.TextBox3.Text = .Cells(frmName, frmDate)
End With
End Sub
'Subroutine when clicking the Second ("update") button
Private Sub btnupdate_Click()
'Paste updated Number of tasks in appropriate cells according to name and date
'The new number of tasks should over write what was there previously
With ThisWorkbook.Worksheets("Sheet4")
.Cells(frmName, frmDate) = UserForm1.TextBox3.Text
End With
End Sub