I need a code for this userform, when I choose some item from ComboBox to fill textboxes and optionbutton from my "Sheet1" table.
Something like this would do what you are trying to accomplish. Just insert this wherever you are pulling the other data out.
If Sheets("SheetName").Cells(row, 5) = "Male" Then
OptionButton1 = True
OptionButton2 = False
ElseIf Sheets("SheetName").Cells(row, 5) = "Female" Then
OptionButton1 = False
OptionButton2 = True
Else
MsgBox("Sex not Male or Female")
End If
This is the code for this userform:
Dim Project As Workbook
Dim SheeT As Worksheet
Dim Closing As Boolean
Private Sub UserForm_Initialize()
Set Project = Workbooks("Navi4.xlsm") ' ThisWorkbook
Set SheeT = Project.Worksheets("Sheet1")
With SheeT
ComboBox1.List = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Value
End With
End Sub
Private Sub ComboBox1_Change()
Dim Item As Long
Item = ComboBox1.ListIndex
If Item = -1 Then
Exit Sub ' nothing selected
End If
TextBox1.Value = SheeT.Range("C" & Item + 2).Value
TextBox2.Value = SheeT.Range("D" & Item + 2).Value
If Sheets("Sheet1").Range("E" & Item + 2).Value = "Male" Then
OptionButton1 = True
OptionButton2 = False
ElseIf Sheets("Sheet1").Range("E" & Item + 2).Value = "Female" Then
OptionButton1 = False
OptionButton2 = True
Else
MsgBox ("Sex not Male or Female")
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Closing = True
End Sub
Related
I'm using a vba UserForm to enter in "Vehicle Reg" and choose "Current Status" from a combobox, which currently adds this data to a new line along with a uniqueID, the username, and the time.
I'd like to create a finite list of Vehicle Reg, and use the UserForm to update the Current Status (1 column to the right) with the new value.
Is there a way I can alter what I have to make this work? I am brand new to vba and have been googling for days!
I have a Submit Button, a Reset Button, and on the main spreadsheet I have a macro button that I have attached the "Show Form".
Here's what I have:
Sub Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)] 'identifying the last row
With frmForm
.txtID.Value = ""
.cmbStatus.Clear
.cmbStatus.AddItem "Loaded - In"
.cmbStatus.AddItem "Loaded - Out"
.cmbStatus.AddItem "Empty - Parked"
.cmbStatus.AddItem "Empty - On Bay"
.lstDatabase.ColumnCount = 4
.lstDatabase.ColumnHeads = True
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:C" & iRow
Else
.lstDatabase.RowSource = "Database!A2:C2"
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Database")
iRow = [Counta(Database!A:A)] + 1
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = frmForm.txtID.Value
.Cells(iRow, 3) = frmForm.cmbStatus.Value
.Cells(iRow, 4) = Application.UserName
.Cells(iRow, 5) = [Text(Now(), "DD-MM-YYY HH:MM:SS")]
End With
End Sub
Sub Show_Form()
Call Reset
frmForm.Show
End Sub
**And my initialize code:**
Private Sub UserForm_Initialize()
With frmForm
Height = 370
Width = 645
End With
End Sub
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset
End Sub
Private Sub cmdSave_Click()
With Me
If txtID.Value = "" Then
MsgBox "Reg Cannot Be Blank", vbOKOnly + vbCritical + vbDefaultButton1, "Reg Blank"
End If
Exit Sub
End With
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to save?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Submit
Call Reset
Unload Me
End Sub
Private Sub frmForm_Initialize()
Call Reset
End Sub
Thanks!
Use the lstDatabase_Click() event together with the .ListIndex property to load the form items from the sheet. The Reset de-selects the line. Save without a line selected adds a new record, with line selected updates the existing record.
Option Explicit
Sub Show_Form()
frmForm.Show
End Sub
Private Sub cmdReset_Click()
' unselect line lstdatabase
With Me
.txtID.Value = ""
.cmbStatus = ""
.lstDatabase.ListIndex = -1
End With
End Sub
Private Sub UserForm_Initialize()
With Me
.Height = 370
.Width = 645
.txtID.Value = ""
.cmbStatus.Clear
.cmbStatus.AddItem "Loaded - In"
.cmbStatus.AddItem "Loaded - Out"
.cmbStatus.AddItem "Empty - Parked"
.cmbStatus.AddItem "Empty - On Bay"
.lstDatabase.ColumnCount = 4
.lstDatabase.ColumnHeads = True
End With
LoadDatabase
End Sub
Private Sub cmdSave_Click()
If txtID.Value = "" Then
MsgBox "Reg Cannot Be Blank", vbCritical, "Reg Blank"
ElseIf cmbStatus.Value = "" Then
MsgBox "Status Cannot Be Blank", vbCritical, "Status Blank"
ElseIf MsgBox("Do you want to save?", vbYesNo, "Confirmation") = vbYes Then
Call Submit
'Unload Me
End If
End Sub
Sub Submit()
Dim i As Long, r As Long
With lstDatabase
i = .ListIndex
' is line selected
If i >= 0 Then r = .List(i, 0) + 1
End With
' update or add
With Sheets("Database")
' add new find last line
If r = 0 Then
r = 1 + .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(r, 1) = r - 1
.Cells(r, 2) = frmForm.txtID.Value
End If
' update
.Cells(r, 3) = frmForm.cmbStatus.Value
.Cells(r, 4) = Application.UserName
.Cells(r, 5) = [Text(Now(), "DD-MM-YYY HH:MM:SS")]
End With
End Sub
Private Sub lstDatabase_Click()
Dim i As Long, r As Long
With lstDatabase
i = .ListIndex
If i >= 0 Then
txtID.Value = .List(i, 1)
cmbStatus.Text = .List(i, 2)
End If
End With
End Sub
Sub LoadDatabase()
Dim iRow As Long
With Sheets("Database")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If iRow < 2 Then iRow = 2
lstDatabase.RowSource = "Database!A2:C" & iRow
End Sub
I am completely new in this and got stuck on something that sounds like a simple thing.
I created simple user form, where assemblers will enter one of the items as a search criteria. The listbox is then populated with all results from original spreadsheet showing the location of that part. Assembler will then select one item that they need to pick and click the button "pick".
What that will do is enter the date in "PickDate" in spreadsheet. And that is where I am stuck.
My thinking was to select the row in the spreadsheet identical to the selected row in listbox, and then create address of the cell using that row and column. But it doesn't work. Tried several things that I could find on internet and nothing works. At one point I had date being entered in correct column, but not correct row. Unfortunately, cannot remember what that code was.
Any help would be appreciated.
Thanks a lot. userform spreadsheet
Private Sub PickBtn_Click()
Dim i As Integer
For i = 1 To Range("A10000").End(xlUp).Row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
.Range(Selection, 7).Value = Date
End If
Next i
End Sub
Entry form
Private Sub CancelJob_Click()
'Close EntryForm form
Unload EntryForm
'Show InitialForm form
InitialForm.Show
End Sub
Private Sub UserForm_Initialize()
'Empty all fields
JobBox.Value = ""
Customer.Value = ""
Location.Value = ""
Rack.Value = ""
'Fill combo box with product types
With ProductCombo
.AddItem "Channel Letter Faces"
.AddItem "Channel Letter Backers"
.AddItem "Routed Aluminum Panels"
.AddItem "Routed ACM Panels"
End With
'Set focus on Work order TextBox
JobBox.SetFocus
End Sub
Private Sub SubmitJob_Click()
'Make fields mandatory
If JobBox.Value = "" Or ProductCombo.Value = "" Or Rack.Value = "" Then
If MsgBox("Cannot submit. Please fill the mandatory fields.",
vbQuestion + vbOKOnly) <> vbOKOnly Then
Exit Sub
End If
End If
'Start transfering process
Dim emptyRow As Long
'Make Sheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information to the table
Cells(emptyRow, 1).Value = Date 'Auto populate 1st column with submission date
Cells(emptyRow, 2).Value = JobBox.Value
Cells(emptyRow, 3).Value = Customer.Value
Cells(emptyRow, 4).Value = Location.Value
Cells(emptyRow, 5).Value = ProductCombo.Value
Cells(emptyRow, 6).Value = Rack.Value
'Save workbook after transfer of data
ActiveWorkbook.Save
'Close EntryForm
Unload Me
'Quit application so that others can use it
'Application.Quit
End Sub
This is complete code for this search part of the userform that I cannot
figure out (I was playing with the code for "submit" button that I am stuck). Maybe it will help for troubleshooting:
Private Sub ClearForm(Except As String)
' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it
Select Case Except
Case "Job"
FormEvents = False
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Customer"
FormEvents = False
Job.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Location"
FormEvents = False
Job.Value = ""
Customer.Value = ""
Results.Clear
FormEvents = True
Case Else
FormEvents = False
Job.Value = ""
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
End Select
End Sub
Private Sub ClearBtn_Click()
ClearForm ("")
End Sub
Private Sub Job_Change()
If FormEvents Then ClearForm ("Job")
End Sub
Private Sub Customer_Change()
If FormEvents Then ClearForm ("Customer")
End Sub
Private Sub Location_Change()
If FormEvents Then ClearForm ("Location")
End Sub
Private Sub PickBtn_Click()
Dim i As Integer
Sheet1.Activate
For i = 1 To Range("A10000").End(xlUp).row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
Me.Range("Selection:G").Value = Date
End If
Next i
End Sub
Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' Display an error if no search term is entered
If Job.Value = "" And Customer.Value = "" And Location.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Work out what is being searched for
If Job.Value <> "" Then
SearchTerm = Job.Value
SearchColumn = "Job"
End If
If Customer.Value <> "" Then
SearchTerm = Customer.Value
SearchColumn = "Customer"
End If
If Location.Value <> "" Then
SearchTerm = Location.Value
SearchColumn = "Location"
End If
Results.Clear
' Only search in the relevant table column i.e. if somone is
searching Location
' only search in the Location column
With Range("Table1[" & SearchColumn & "]")
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' Set the first cell in the row of the matching value
Set FirstCell = Range("B" & RecordRange.row)
' Add matching record to List Box
Results.AddItem
Results.List(RowCount, 0) = FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1, 2)
Results.List(RowCount, 2) = FirstCell(1, 3)
Results.List(RowCount, 3) = FirstCell(1, 4)
Results.List(RowCount, 4) = FirstCell(1, 5)
Results.List(RowCount, 5) = FirstCell(1, 7)
RowCount = RowCount + 1
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
Results.AddItem
Results.List(RowCount, 0) = "Nothing Found"
End If
End With
End Sub
Private Sub UserForm_Initialize()
FormEvents = True
End Sub
Add another column in the list box to hold the row number.
Results.List(RowCount, 6) = FirstCell.Row
And then code becomes
Private Sub PickBtn_Click()
Dim r as long
r = Results.List(Results.ListIndex,6)
Range(r, 7).Value = Date
End Sub
I am trying to create a form:
where you are able to select multiple items and it display in excel sheet
I was able to do so for selecting only one item in a list, but when changed to multi select I don't know how to link the form and the worksheet together.
Also - how do I make it display in the "database" portion of my form here:
code for Module 1
Option Explicit
Sub Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)] ' identifying the last row
With frmForm
.txtName.Value = ""
.txtAge.Value = "'"
.lstInvited.Clear
.lstInvited.AddItem "Aya"
.lstInvited.AddItem "Bi"
.lstInvited.AddItem "Britt"
.lstInvited.AddItem "Cami"
.lstInvited.AddItem "Sarl"
.lstInvited.AddItem "Ch"
.cmbTeacher.Clear
.cmbTeacher.AddItem "A"
.cmbTeacher.AddItem "Bia"
.cmbTeacher.AddItem "Cami"
.cmbTeacher.AddItem "China"
.cmbStudy.Clear
.cmbStudy.AddItem "1"
.cmbStudy.AddItem "2"
.cmbStudy.AddItem "3"
.cmbStudy.AddItem "45"
.lstAction.Clear
.lstAction.AddItem "Wants to study again"
.lstAction.AddItem "Other, Please specify in Notes"
.lstInfo.Clear
.lstInfo.AddItem "Open-minded"
.lstInfo.AddItem "Needs to study in a different language"
.lstInfo.AddItem "Other, Please specify in Notes"
.lstZoom.Clear
.lstZoom.AddItem "Attentive"
.lstZoom.AddItem "Not interactive/ Not connected"
.lstZoom.AddItem "Occupied"
.lstZoom.AddItem "Other, Please specify in Notes"
.txtNotes.Value = ""
.lstDatabase.ColumnCount = 10
.lstDatabase.ColumnHeads = True
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:J" & iRow
Else
.lstDatabase.RowSource = "Database!A2:J2"
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Database")
iRow = [Counta(Database!A:A)] + 1
With sh
.Cells(iRow, 1) = frmForm.txtName.Value
.Cells(iRow, 2) = frmForm.lstInvited.Value
.Cells(iRow, 3) = frmForm.txtAge.Value
.Cells(iRow, 4) = frmForm.cmbTeacher.Value
.Cells(iRow, 5) = frmForm.cmbStudy.Value
.Cells(iRow, 6) = frmForm.dtpDate.Value
.Cells(iRow, 7) = frmForm.lstAction.Value
.Cells(iRow, 8) = frmForm.lstInfo.Value
.Cells(iRow, 9) = frmForm.lstZoom.Value
.Cells(iRow, 10) = frmForm.txtNotes.Value
End With
End Sub
Sub Show_Form()
frmForm.Show
End Sub
`
and then here is the code for form (frmForm)
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox(" Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset
End Sub
Private Sub cmdSave_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox(" Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Submit
Call Reset
End Sub
Private Sub lstInvited_Initialize()
Me.lstInvited.RowSource = strInvitedList
End Sub
Private Sub lstAction_Initialize()
Me.lstAction.RowSource = strDVActionList
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub lstAction_Click()
For i = 0 To lstAction.ListCount - 1
If lstAction.Selected(i) = True Then
ListBox2.AddItem
ListBox2.Column(0, (ListBox2.ListCount - 1)) = ListBox1.Column(0, i)
ListBox2.Column(1, (ListBox2.ListCount - 1)) = ListBox1.Column(1, i)
ListBox2.Column(2, (ListBox2.ListCount - 1)) = ListBox1.Column(2, i)
End If
Next
End Sub
Private Sub UserForm_Initialize()
Call Reset
End Sub
You'll need to loop through the list box. You can use the .ListCount property to get the number of rows (the index starts at 0 so use .ListCount - 1). You can check if the index is selected by using .Selected(i) where i is the loop counter.
So if your listbox is called ListBox1 you can do something like this to determine what rows are selected:
For i = 0 to ListBox1.Count - 1
If ListBox1.Selected(i) = True Then Debug.Print "Index " & i & " is selected"
Next i
Instead of the debug message you can add the information to your worksheet by using the listbox .List method, you'll need to use i for the row parameter and whatever number you need for the column parameter.
To add the information to the form you can use the .List method again to set those properties.
You may also want to look into assigning the values to an array as this would shorten your code.
I'm writing a Userform
What I am trying to achieve: while running my Userform with multiple selection checkboxes.
Collect all checked checkboxes captions along with its parent frame name
Filtering database on its first column with those collected strings
Loop through filtered cells and make the wanted sums
The selection can contain each row with different columns (Based on checkbox selection)
Coded for Estimate command button:
Private Sub preflight_calculate_Click()
Dim preflight_resource As Double, preflight_time As Double
preflight_resource = Val(Me.preflight_resource)
preflight_time = Val(Me.preflight_time)
Dim cell As Range
With ThisWorkbook.Sheets("Preflight")
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
.AutoFilter 1, Criteria1:=GetCheckedCaptions, Operator:=xlFilterValues
For Each cell In .SpecialCells(xlCellTypeVisible)
preflight_resource = preflight_resource + cell.Offset(, 6).Value
preflight_time = preflight_time + cell.Offset(, 8).Value
Next
End With
.AutoFilterMode = False
End With
With Me
.preflight_resource.Text = preflight_resource
.preflight_time.Text = preflight_time
End With
End Sub
Function GetCheckedCaptions() As Variant
Dim ctl As Control
With Me
For Each ctl In .Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value Then
GetCheckedCaptions = GetCheckedCaptions & " " & ctl.Parent.Caption & "-" & ctl.Caption
End If
End If
Next
End With
GetCheckedCaptions = Split(Trim(GetCheckedCaptions))
End Function
Error code line:
preflight_resource = preflight_resource + cell.Offset(, 6).Value
Expected result:
For Example:
If I select the checkbox as follows US -> Mobile -> P0 and US -> Desktop -> P1
Output should be:
Textboxes below:
Resource Utilized: (F2 + G3) -> (0.73 + 0.62) -> 1.35 (Inside text box)
Time in Hours: (H2 + I3) -> (5.87 + 4.95) -> 10.82 (Inside text box)
How to achieve this?
I have a different approach to solve your question's problem.
If having a separate columns to store the values of each selection is an option, then check it out.
Summary of what happens in the spreadsheet:
Checkboxes data will be stored by VBA code in columns L to O
Cells L25 and N25 will sum total resources and time by adding the formulas (in each cell)
L25 -> =SUM(L2:M23)
N25 -> =SUM(N2:O23)
Here you can download the current file: https://1drv.ms/x/s!ArAKssDW3T7wlKMfhNyjEDsHmkxz-g
This will be the setup
The code behind the userform is as follows. Customize it reading each comment:
Option Explicit
Private Sub knightregression_yes_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.knightregression_yes, "Mobile", "Knight regression" ' In this case the task title is specified (last sub argument)
Application.EnableEvents = True
End Sub
Private Sub preflight_no_Click()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.preflight_no
Application.EnableEvents = True
End Sub
Private Sub preflight_yes_Click()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.preflight_yes
Application.EnableEvents = True
End Sub
Private Sub us_desktop_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_desktop
Application.EnableEvents = True
End Sub
Private Sub us_dp0_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_dp0, "Desktop"
Application.EnableEvents = True
End Sub
Private Sub us_mobile_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_mobile
Application.EnableEvents = True
End Sub
Private Sub us_mp0_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp0, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_mp1_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp1, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_mp2_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp2, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_yes_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_yes
Application.EnableEvents = True
End Sub
Private Sub UserForm_Initialize()
Dim formControl As MSForms.Control
' Clear preflight selections
ThisWorkbook.Worksheets("Preflight").Range("L2:O32").ClearContents
' Make all checkboxes unchecked and disabled except preflight test
For Each formControl In Me.Controls
If TypeOf formControl Is MSForms.CheckBox Then
If InStr(formControl.Name, "preflight") = 0 Then
formControl.Value = False
formControl.Enabled = False
End If
End If
Next
' Empty resource and time textboxes
Me.preflight_resource = vbNullString
Me.preflight_time = vbNullString
End Sub
Private Sub ComboBox2_Change()
Dim index As Integer
index = ComboBox2.ListIndex
lstAll.Clear
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Select Case index
Case Is = 0
With lstAll
Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If
End With
Case Is = 1
With lstAll
.AddItem "No Task"
End With
Case Is = 2
With lstAll
.AddItem "No Task"
End With
End Select
End Sub
Private Sub Newfeatureyes_Click()
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Dim i As Long, LastRow As Long
LastRow = Sheets("NewFeature").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("NewFeature").Cells(i, "A").Value
Next i
End If
End Sub
Private Sub Newfeatureno_Click()
lstAll.Clear
lst_Added.Clear
mobileutilize = ""
mobilehours = ""
desktoputilize = ""
desktophours = ""
End Sub
Private Sub submitmobile_Click()
Dim i As Long, j As Long, LastRow As Long
Dim lbValue As String
Dim ws As Worksheet
If lst_Added.ListCount = 0 Then
MsgBox "Please add atleast 1 task"
Exit Sub
End If
mobileutilize = ""
mobilehours = ""
Set ws = ThisWorkbook.Sheets("NewFeature")
With ws
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
For j = 0 To lst_Added.ListCount - 1
lbValue = lst_Added.List(j)
If .Cells(i, "A").Value = lbValue Or _
.Cells(i, "A").Value = Val(lbValue) Then
mobileutilize = Val(mobileutilize) + Val(.Cells(i, "F").Value)
mobilehours = Val(mobilehours) + Val(.Cells(i, "H").Value)
End If
Next
Next
End With
End Sub
Private Sub submitdesktop_Click()
Dim i As Long, j As Long, LastRow As Long
Dim lbValue As String
Dim ws As Worksheet
If lst_Added.ListCount = 0 Then
MsgBox "Please add atleast 1 task"
Exit Sub
End If
desktoputilize = ""
desktophours = ""
Set ws = ThisWorkbook.Sheets("NewFeature")
With ws
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
For j = 0 To lst_Added.ListCount - 1
lbValue = lst_Added.List(j)
If .Cells(i, "A").Value = lbValue Or _
.Cells(i, "A").Value = Val(lbValue) Then
desktoputilize = Val(desktoputilize) + Val(.Cells(i, "G").Value)
desktophours = Val(desktophours) + Val(.Cells(i, "I").Value)
End If
Next
Next
End With
End Sub
Private Sub cmdAdd_Click()
If lstAll.ListCount = 0 Then
MsgBox "Select an item"
Exit Sub
End If
Dim i As Integer
For i = 0 To lstAll.ListCount - 1
If lstAll.Selected(i) = True Then lst_Added.AddItem lstAll.List(i)
Next i
End Sub
Private Sub cmdRemove_Click()
If lstAll.ListCount = 0 Then
MsgBox "Select an item"
Exit Sub
End If
Dim counter As Integer
counter = 0
For i = 0 To lst_Added.ListCount - 1
If lst_Added.Selected(i - counter) Then
lst_Added.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
Private Sub CommandButton1_Click()
Unload Me
Sheets("Estimation form").Select
Range("A1").Select
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.ComboBox1.ListCount = 0 Then
For i = 2 To LastRow
Me.ComboBox1.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If
End Sub
Also, add a module, name it: mUserForm and add this code:
Option Explicit
' Set userform's controls values depending on which one is calling the function
Public Sub SetUserFormControlsValues(mainUserForm As UserForm1, sourceControl As MSForms.Control)
Dim formControl As MSForms.Control
Dim enableMainCheckBoxes As Boolean
Dim enableMobileCheckBoxes As Boolean
Dim enableDesktopCheckBoxes As Boolean
Dim enableMPCheckboxes As Boolean
Dim enableDPCheckboxes As Boolean
Dim countryCode As String
Dim subcontrolList() As String
Dim counter As Integer
Select Case sourceControl.Name
' If preflight yes or no
Case "preflight_yes"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = False ' xx_mobile
enableDesktopCheckBoxes = False ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
subcontrolList = Split("yes", ",")
Case "preflight_no"
enableMainCheckBoxes = False ' xx_yes
enableMobileCheckBoxes = False ' xx_mobile
enableDesktopCheckBoxes = False ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
subcontrolList = Split("yes", ",")
' If main box yes
Case "us_yes", "uk_yes", "jp_yes", "de_yes", "es_yes", "it_yes", "fr_yes"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = sourceControl.Value ' xx_mobile
enableDesktopCheckBoxes = sourceControl.Value ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("mobile,desktop", ",")
' If mobile yes
Case "us_mobile", "uk_mobile", "jp_mobile", "de_mobile", "es_mobile", "it_mobile", "fr_mobile"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = True ' xx_mobile
enableDesktopCheckBoxes = True ' xx_desktop
enableMPCheckboxes = True ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("mp", ",")
' if desktop yes
Case "us_desktop", "uk_desktop", "jp_desktop", "de_desktop", "es_desktop", "it_desktop", "fr_desktop"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = True ' xx_mobile
enableDesktopCheckBoxes = True ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = True ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("dp", ",")
End Select
For Each formControl In mainUserForm.Controls
If TypeOf formControl Is MSForms.CheckBox Then
' Set sub controls value
For counter = 0 To UBound(subcontrolList)
If sourceControl.Name = "preflight_yes" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = True
formControl.Value = False
ElseIf sourceControl.Name = "preflight_no" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = False
formControl.Value = False
ElseIf InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = sourceControl.Value
formControl.Value = False
End If
Next counter
End If
Next
mainUserForm.releasenote_yes.Value = False
mainUserForm.automationfail_yes.Value = False
mainUserForm.knightregression_yes.Value = False
mainUserForm.releasenote_yes.Enabled = True
mainUserForm.automationfail_yes.Enabled = True
mainUserForm.knightregression_yes.Enabled = True
' Empty resource and time textboxes
mainUserForm.preflight_resource = vbNullString
mainUserForm.preflight_time = vbNullString
End Sub
' Record values according to checkboxes checked in form
Public Sub RecordCheckboxChange(mainUserForm As UserForm1, checkBoxControl As MSForms.CheckBox, formType As String, Optional exactTaskTitle As String)
' Declare objects
Dim resultRange As Range
' Declare other variables
Dim parentCaption As String
Dim checkboxCaption As String
Dim taskTitle As String
Dim resourceValue As Double
Dim timeValue As Double
Dim resourceColumn As Integer
Dim timeColumn As Integer
' Reset find parameters
Application.FindFormat.Clear
' Define which column to sum based on formType
Select Case formType
Case "Mobile"
resourceColumn = 5
timeColumn = 7
Case "Desktop"
resourceColumn = 6
timeColumn = 8
End Select
' Store the captions (parent and checkbox)
parentCaption = checkBoxControl.Parent.Caption
checkboxCaption = checkBoxControl.Caption
' If task title comes from code inside checkbox event, use it
If exactTaskTitle <> vbNullString Then
taskTitle = exactTaskTitle
Else
taskTitle = parentCaption & "*" & checkboxCaption
End If
' Find the parent and checkbox caption (using wildcards it's more simple)
Set resultRange = Sheets("Preflight").Range("A2:A32").Find(taskTitle, Lookat:=xlPart)
' If checkbox is checked record value
If checkBoxControl.Value = True Then
resourceValue = resultRange.Offset(0, resourceColumn).Value
timeValue = resultRange.Offset(0, timeColumn).Value
Else
resourceValue = 0
timeValue = 0
End If
' Store the value in spreadsheet
resultRange.Offset(0, resourceColumn + 6).Value = resourceValue
resultRange.Offset(0, timeColumn + 6).Value = timeValue
' Update the textboxes with totals
mainUserForm.preflight_resource = ThisWorkbook.Worksheets("Preflight").Range("L35").Value
mainUserForm.preflight_time = ThisWorkbook.Worksheets("Preflight").Range("N35").Value
' Reset find parameters
Application.FindFormat.Clear
End Sub
I have a set of 4 rows of data, i need to make the first row data's visible automatically in userform excel using vb , when i click on the button in ribbon. Later by clicking on next row it needs to display the complete data's of next row.
for example,
stud_id stud_name age gender
1 a 20 M
2 b 22 M
3 c 25 F
4 d 22 F
Public ncurretnrow As Long
Sub Userform_Initialize()
ncurrentrow = Sheet3("2017").Cells(Rows.Count, 1).End(xlDown).Offset(1, 0).Row
traversedata (ncurrentrow)
End Sub
Public Sub traversedata(nrow As Long)
Me.stud_id.Value = ws.Cells(nrow, 1).Value
Me.stud_name.Value = ws.Cells(nrow, 2).Value
Me.age.Value = ws.Cells(nrow, 2).Value
If Optionyes = True Then
Me.genderm.Value = ws.Cells(nrow, 3).Value
Else
Me.genderf.Value = ws.Cells(nrow, 3).Value
End If
See code below (both Subs inside the User_Form module).
Public ws As Worksheet
Private Sub UserForm_Initialize()
Dim HeaderRng As Range
Dim ncurretnrow As Long
' set the worksheet object
Set ws = ThisWorkbook.Sheets("2017")
Set HeaderRng = ws.Cells.Find(what:="stud_id") ' look for the header (below it you will find the first row with data)
If Not HeaderRng Is Nothing Then
ncurretnrow = HeaderRng.Row + 1
Else
MsgBox "Unable to find stud_id header", vbCritical
Exit Sub
End If
traversedata ncurretnrow
End Sub
Sub traversedata(nrow As Long)
With Me
.stud_id.Value = ws.Cells(nrow, 1).Value
.stud_name.Value = ws.Cells(nrow, 2).Value
.age.Value = ws.Cells(nrow, 3).Value
If Optionyes = True Then
.genderm.Value = ws.Cells(nrow, 4).Value
Else
.genderf.Value = ws.Cells(nrow, 4).Value
End If
End With
End Sub