Why does Userform freezes after hiding and showing it multiple times - vba

Ok, i have question on hiding and showing userforms.
This link already answered it for me.
Problem is I encounter another problem.
When I go back to Userform1 it freezes and I can't do anything at all.
Why? Do i need to add something in the code?
Heres the summay of the code i used:
This code prompts user to enter username and password
Option Explicit
Private Sub CBu_Login_Click()
Dim ws As Worksheet, rng As Range, lrow As Long, find_value As String
Dim cel As Range
Set ws = ThisWorkbook.Sheets("UserName")
lrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A2:A" & lrow)
find_value = Me.TB_Username.Value
Set cel = rng.Find(What:=find_value, After:=ws.Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel Is Nothing Then
If Me.TB_Password.Value = cel.Offset(0, 1).Value Then
Me.Hide
UF_Encoding.L_User.Caption = "Welcome " & cel.Offset(0, 2).Value & "!" & " You are logged in."
UF_Encoding.TB_Operator.Text = cel.Offset(0, 2).Value
UF_Encoding.TB_ESN_IMEI.Value = ""
UF_Encoding.CB_PrimaryCode.Value = ""
UF_Encoding.CB_SecondaryCode.Value = ""
UF_Encoding.TB_Remarks.Value = ""
UF_Encoding.TB_ESN_IMEI.SetFocus
UF_Encoding.Show
Else
MsgBox "Invalid Username/Password"
End If
Else
MsgBox "Invalid Username/Password"
End If
End Sub
This code is for logging out:
I used Listbox here so the user can select which action to take.
Private Sub LB_Options_AfterUpdate()
If Me.LB_Options.Value = "Log out" Then
Me.Hide
Me.LB_Options.Visible = False
UF_Login.TB_Username.Value = ""
UF_Login.TB_Password.Value = ""
UF_Login.Show
ElseIf Me.LB_Options.Value = "Change Password" Then
Me.Hide
Me.LB_Options.Visible = False
UF_Changepass.TB_User.Value = ""
UF_Changepass.TB_Newpass.Value = ""
UF_Changepass.TB_Oldpass.Value = ""
UF_Changepass.Show
ElseIf Me.LB_Options.Value = "Exit" Then
Me.Hide
wbDbase.Save
wbDbase.Close
wbEncoding.Save
wbEncoding.Close
Unload UF_Login
Unload UF_Changepass
Unload Me
End If
Well this does what i wan't. Log in, log out, change pass and exit.
But as I've, said the Forms freezes after 1st execution.
Example:
1. I initialize UF_Login and then UF_Encoding appears.
2. It works, all commandbuttons and text boxes works.
3. Then I log out using the list box.
4. When i log in again, it will show UF_Encoding but when i try to use the commanb buttons and text boxes, it doesn't work.
5. Strange thing is that the list box with log out, change pass and exit works.
I'm really having a hard time figuring out why.
Any help is appreciated.

Give this a try. It's "rough" code, and certainly needs refining, but it works, and should give you some ideas.
This goes in UF_Encoding
Option Explicit
'UF_Encoding form
Private msLBox As String
Private msUser As String
Public Property Let psUser(s As String)
msUser = s
End Property
Public Property Get psLBox() As String
psLBox = msLBox
End Property
Private Sub LB_Options_AfterUpdate()
msLBox = Me.LB_Options.Value
If Me.LB_Options.Value = "Log out" Then
Me.Hide
Me.LB_Options.Visible = False
UF_Login.TB_Username.Value = ""
UF_Login.TB_Password.Value = ""
ElseIf Me.LB_Options.Value = "Change Password" Then
Me.Hide
Me.LB_Options.Visible = False
UF_Changepass.TB_User.Value = ""
UF_Changepass.TB_Newpass.Value = ""
UF_Changepass.TB_Oldpass.Value = ""
ElseIf Me.LB_Options.Value = "Exit" Then
Me.Hide
' wbDbase.Save
' wbDbase.Close
' wbEncoding.Save
' wbEncoding.Close
' Unload UF_Login
' Unload UF_Changepass
' Unload Me
End If
End Sub
Private Sub UserForm_Activate()
Me.L_User.Caption = "Welcome " & msUser & "!" & " You are logged in."
Me.TB_Operator.Text = msUser
msLBox = "" 'reset each time form re-entered
Me.LB_Options.Visible = True
End Sub
Private Sub UserForm_Initialize()
Me.LB_Options.AddItem "Log out"
Me.LB_Options.AddItem "Change Password"
Me.LB_Options.AddItem "Exit"
Me.TB_ESN_IMEI.Value = ""
Me.CB_PrimaryCode.Value = ""
Me.CB_SecondaryCode.Value = ""
Me.TB_Remarks.Value = ""
Me.TB_ESN_IMEI.SetFocus
End Sub
This goes in UF_Login
Option Explicit
'UF_Login form
Private msUser As String
Public Property Get psUser() As String
psUser = msUser
End Property
Private Sub CBu_Login_Click()
Dim ws As Worksheet, rng As Range, lrow As Long, find_value As String
Dim cel As Range
Set ws = ThisWorkbook.Sheets("UserName")
lrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A2:A" & lrow)
find_value = Me.TB_Username.Value
Set cel = rng.Find(What:=find_value, After:=ws.Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel Is Nothing Then
If Me.TB_Password.Value = cel.Offset(0, 1).Value Then
msUser = cel.Offset(0, 2).Value 'save user name
Me.Hide
Else
MsgBox "Invalid Username/Password"
End If
Else
MsgBox "Invalid Username/Password"
End If
End Sub
This goes in UF_Changepass
Option Explicit
'UF_Changepass form
Private Sub CMDok_Click()
Dim ws As Worksheet, rng As Range
Set ws = ThisWorkbook.Sheets("UserName")
ws.Columns("B:B").Find(Me.TB_Oldpass, , xlValues, xlWhole, , , False).Value = Me.TB_Newpass
Me.Hide
End Sub
Private Sub UserForm_Click()
This code goes in a regular module
Option Explicit
Dim fLogin As UF_Login
Dim fEnc As UF_Encoding
Dim fChg As UF_Changepass
Sub main()
Dim s As String
' initialize all 3 forms
Set fLogin = New UF_Login
Set fEnc = New UF_Encoding
Set fChg = New UF_Changepass
fLogin.Show '1st time
' re-display main form until done
Do
fEnc.psUser = fLogin.psUser 'pass user name to main form
fEnc.Show
s = fEnc.psLBox 'get listbox value
If s <> "Exit" Then showAuxForms s
Loop Until s = "Exit"
' done with forms
Unload fLogin
Unload fEnc
Unload fChg
Set fLogin = Nothing
Set fEnc = Nothing
Set fChg = Nothing
End Sub
Sub showAuxForms(s As String)
If s = "Log out" Then
fLogin.Show
ElseIf s = "Change Password" Then
fChg.Show
End If
End Sub

To allow multiple switches between UserForms, it is better to unload the forms you're not using and then just reload it when it's time to use it again. Something like:
Me.Hide '/* hide the initiating form first */
Load UF_Login '/* loads the form, but not shown */
With UF_Login
.TB_Username.Value = ""
.TB_Password.Value = ""
.Show
End With
Unload Me '/* unload the initiating form */
In the UF_Login, a code to view the UF_Encoding will be added to make it look like you're actually logging in and out of the form.
Private Sub CB_Login_Click()
'/* code to check log-in credentials goes here */
Me.Hide
Load UF_Encoding
UF_Encoding.Show
Unload Me
End Sub

Related

Inserting values from a UserForm to excel sheet which start from a fixed cell?

I have a Cell range Sheets("INVOICE MAKER").Range("D18:D37") (Total 20 Cells), and a little UserForm with name Add Items.
In UserForm there are one Textbox and one Submit Button.
So if I write something in that Textbox and click on Submit Button, Data should be write to next available empty cell in range Sheets("INVOICE MAKER").Range("D18:D37"). And if all 20 cells are filled with data then show a message like "No more rows are available to write data".
Below code don't start writing data from Cell D18, its start writing data from D1.
and doesn't stop after cell D37.
Option Explicit
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("INVOICE MAKER")
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.Textbox.Value) = "" Then
Me.Textbox.SetFocus
MsgBox "Please Type Item Name"
Exit Sub
End If
With ws
.Cells(lRow, 5).Value = Me.Textbox.Value
End With
End Sub
Hope below code will help you:
Public Working_Sheet As Worksheet
Public All_Cell_Value As Boolean
Public Write_Cell_No As Integer
Public Content As String
'When button in the form is clicked
Sub Button1_Click()
Write_Content
End Sub
'validation and content writing function
Public Function Write_Content()
All_Cell_Value = True
Set Working_Sheet = Worksheets("Sheet1")
For i = 18 To 37
If Trim(Working_Sheet.Cells(i, "D")) = "" Then
All_Cell_Value = False
Write_Cell_No = i
Exit For
End If
Next i
If All_Cell_Value = False Then
Content = InputBox("Enter the value")
If Content = "" Then
MsgBox ("No Data")
Else
Working_Sheet.Cells(i, "D").Value = Content
End If
Else
MsgBox ("Sorry content is full")
End If
End Function
Maybe this will help!
EDIT #1
Fix some errors, and the code must to be inside a Form, with the TextBox and the Button
EDIT #2
Added a closing statement for the userform or the macro
Option Explicit
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("INVOICE MAKER") 'Set from Thisworkbook
ws.Activate 'activate the Invoice Maker
'lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
Dim iniCell As Integer: iniCell = 18
Dim endCell As Integer: endCell = 37
Dim setCol As Integer: setCol = ws.Range("D1").Column
'As you said, the range is D18:D37, then you can manipulate from this 3 vars
Dim iRange As Range
Dim i As Range
Dim isTheRangeFull As Boolean: isTheRangeFull = False
Dim iMsgbox As Integer
If Trim(Me.TextBox.Value) = "" Then
Me.TextBox.SetFocus
'Ask the user to retry or quit.
iMsgbox = MsgBox("Please Type Item Name" & Chr(10) & "Do you want to retry?", vbYesNo + vbDefaultButton1)
If iMsgbox = 6 Then
GoTo InsertData
'if the user say YES
'do it again
ElseIf iMsgbox = 7 Then
End
'if the user say NO
End If
End If
Set iRange = ws.Range(Cells(iniCell, setCol), Cells(endCell, setCol))
'set your working Range
'This Loop do the job!
For Each i In iRange
isTheRangeFull = True
'if there is no empty cell, won't enter the if, and
'the var continue TRUE, so there is no empty cells...
If i.Value = Empty Then
i.Value = Me.TextBox.Value
isTheRangeFull = False
'the Next line (End) Will close the Form and terminate the macro
'End
'The next line just close the userform
'Unload Me
'Decide which one to uncomment.
Exit For
End If
Next i
If isTheRangeFull Then
MsgBox "No more rows are available to write data"
End
End If
'With ws
' .Cells(lRow, 5).Value = Me.TextBox.Value
'End With
InsertData:
End Sub

VBA Excel assistance in userform refedit control

I have setup my userform perfectly so that when the user enters the date it shows in a label box in the userform it self.
All I'm struggling with is using my output frame as shown, which contains a refEdit control and a button. I am trying to have the date to be placed on any worksheet cell.
Image of my userform:
So far the code that I have come up with is the following:
Private Sub avgBtn_Click()
Dim range1 As String
Dim newdate As String
range1 = TextBox3.Value + "," + TextBox1.Value + " " + TextBox2.Value + "," + TextBox4.Value
newdate = range1
Label7.Caption = newdate
End Sub
Private Sub cancelBtn_Click()
Unload Task2
End Sub
Private Sub CommandButton1_Click()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End Sub
Private Sub UserForm_Click()
Unload UserForm1
End Sub
For the refedit control and command button I have come up with this code but it is giving me errors:
Sub CommandButton2_Click()
Dim myCell As Range
Set myCell = Nothing
On Error Resume Next
Set myCell = Range(Me.RefEdit1.Value).Areas(1).Cells(1)
myCell.value = Label7.Caption
End Sub
Would appreciate any feedback in regards to this code.

how to set same assign commandbutton in each worksheet

I want to make commandButon every time I insert newsheet with the same name(TestButton). In the hope that if CommandButton click will call the procedure Tester. This applies to the CommandButton in all sheet. My code is as following:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim Obj As Object
Dim Code As String
Dim LF As String 'Line feed or carriage return
LF = Chr(13)
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=880, Top:=20, Width:=100, Height:=50)
Obj.Name = "TestButton"
'buttonn text
ActiveSheet.OLEObjects(1).Object.Caption = "Send"
'macro text
Code = "Sub TestButton_Click()" & LF
Code = Code & "Call Tester" & LF
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End Sub
Sub Tester()
MsgBox "You have click on the test button"
End Sub
but I get an error message "Run-time error 1004 Programmatic access to Visual Basic is not trusted". how to solve it?
You should setup a worksheet how you want it and hide it. Use that worksheet as a template. Whenever you add a worksheet, replace it with a copy of the template.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim WorkSheetName As String
Dim i As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = fasle
i = Sh.Index
Worksheets("HiddenTempalte").Copy After:=Worksheets(i)
WorkSheetName = Sh.Name
Sh.Delete
Worksheets(i).Name = WorkSheetName
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
"Trust Access to VBA Project":
How to check from .net code whether "Trust access to the VBA project object model" is enabled or not for an Excel application?
Consider using a Forms button instead:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
With Sh.Buttons.Add(Left:=880, Top:=20, Width:=100, Height:=50)
.Caption = "Send"
.OnAction = "Tester"
End With
End Sub
Public Sub Tester()
MsgBox "You have click on the test button"
End Sub

vba excel combo box in userform

Basically the module Onboarding is asking the path of the tracker i want to update. I am updating details in the
sheet1 of the tracker.
I am setting the values of fields in userform 'OnboardingForm' to blank(so that the values entered last time to the
form is not visible when I am opening the form this time.
Now I am opening the form 'OnboardingForm' and entering values in the subsequent fields.
I have put a check button in my userform 'OnboardingForm' which is invisible to the front end user.
Now in the tracker there is a sheet named 'Project Tracks' which has information of all current projects
Once the submit button is clicked the control will go to the tracker's 'Project Tracks' sheet. It will validate the
track entered in the userform 'OnboardingForm' with the tracks present in the tracker's 'Project Tracks' sheet. Once found the other details against that particular track will get fetched to the tracker's sheet1(this I have done so that I will not have to enter values manually to the userform 'OnboardingForm' so that the form looks simple). There are no chances of the track not
matching.
Now one command button new track has been put in my current userform 'OnboardingForm'. Once clicked this will take the control to
the userform2 'ProjectTracksForm'.This is basically put so that if I am adding a new track, the form takes the detail and enters in the
tracker's 'Project Tracks' sheet.
Question 1> My current userform's Track button is a combo box. How do I add values in the dropdown from the tracker's
'Project Tracker' sheet to the dropdown.
Question 2> Once I add a new track in userform2 'ProjectTracksForm',submit and then when I come back to my current
userform 'OnboardingForm' that added track should be shown in the dropdown of Track combo box.
Please find below my piece of code.
This is my module for onboarding
Public Sub OnBoarding()
On Error GoTo ErrorHandler
Dim Owb As Object
Dim ran As Range
strTalentTrackerPath = shTracker.Cells(2, 2).Value
'Default the form values to null
With OnboardingForm
.combTrackofWork.Value = ""
.txtFirstName.Text = ""
.txtLastName.Text = ""
.combResCat.Value = ""
.combBFTE.Value = ""
.combLevel.Value = ""
.combLocType = ""
.txtAccessInfo.Text = ""
End With
OnboardingForm.Show
SetFocus.combTrackofWork
With OnboardingForm
'Details to be entered in the form'
strTOW = Trim$(.combTrackofWork.Value)
strFN = Trim$(.txtFirstName.Text)
strLN = Trim$(.txtLastName.Text)
strResCat = Trim$(.combResCat.Value)
strBilFTE = Trim$(.combBFTE.Value)
strLevel = Trim$(.combLevel.Value)
strLocType = (.combLocType.Value)
strAccessInfo = (.txtAccessInfo.Text)
End With
If OnboardingForm.chkOKButtonClick = True Then
Set oExcel = New Excel.Application
strMyFolder = strTalentTrackerPath
Set Owb = oExcel.Workbooks.Open(strMyFolder)
IntRowCount = Owb.Sheets(1).UsedRange.Rows.Count
With Owb.Sheets(1)
With Owb.Sheets("Project Tracks")
IntTrackRowCount = .UsedRange.Rows.Count
For IntCurrentRow = 1 To IntTrackRowCount
If .Cells(IntCurrentRow, 1) = strTOW Then
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colTrack)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colBPO) = .Cells _
(IntCurrentRow, ProjectTrackscolumn.colBPO)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colCostCenter) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colCostCenter)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colGroup) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colGroup)
Exit For
End If
Next
End With
End With
.Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) = strTOW
.Cells(IntRowCount + 1, OnboardingFormcolumn.colFirstName) = strFN
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLastName) = strLN
.Cells(IntRowCount + 1, OnboardingFormcolumn.colResourceCategory) = strResCat
.Cells(IntRowCount + 1, OnboardingFormcolumn.colBilledFTE) = strBilFTE
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLevel) = strLevel
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLocationType) = strLocType
.Cells(IntRowCount + 1, OnboardingFormcolumn.colAccessInformation) = strAccessInfo
Owb.Close True
Set Owb = Nothing
Set oExcel = Nothing
Else
Exit Sub
End If
Exit Sub
ErrorHandler:
If Owb Is Nothing Then
Else
Owb.Close False
End If
If oExcel Is Nothing Then
Else
Set oExcel = Nothing
End If
MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation
End Sub
This is for cancel button of Onboarding Form
Private Sub cmdbtn_Cancel_Click()
OnboardingForm.Hide
MsgBox ("No data entered")
End Sub
This is for OnboardingForm submit button
Private Sub cmdbtn_Submit_Click()
If Trim(OnboardingForm.combTrackOfWork.Value) = "" Then
OnboardingForm.combTOW.SetFocus
MsgBox ("Track of Work cannot be blank")
Exit Sub
End If
If Trim(OnboardingForm.txtFirstName.Value) = "" Then
OnboardingForm.txtFN.SetFocus
MsgBox ("First name cannot be blank")
Exit Sub
End If
If Trim(OnboardingForm.txtLastName.Value) = "" Then
OnboardingForm.txtLN.SetFocus
MsgBox ("Last name cannot be blank")
Exit Sub
End If
End Sub
Module for Project Tracks
Public Sub prjctTracks()
On Error GoTo ErrorHandler
Dim Owb As Object
strTalentTrackerPath = shTracker.Cells(2, 2).Value
With ProjectTracksForm
.txtTOW = ""
.txtBPO = ""
.txtCOCE = ""
.txtSOW = ""
.txtGroup = ""
End With
ProjectTracksForm.Show
With ProjectTracksForm
strTOW = Trim$(.txtTOW.Text)
strBPO = Trim$(.txtBPO.Text)
strCOCE = Trim$(.txtCOCE.Text)
strSOW = Trim$(.txtSOW.Value)
strGroup = Trim$(.txtGroup.Value)
End With
ProjectTracksForm.Hide
If ProjectTracksForm.chkbtn_OKclick = True Then
Set oExcel = New Excel.Application
strMyFolder = strTalentTrackerPath
Set Owb = oExcel.Workbooks.Open(strMyFolder)
With Owb.Sheets("Project Tracks")
intUsedRowCount = .UsedRange.Rows.Count
.Cells(intUsedRowCount + 1, Trackscolumn.colTrack) = strTOW
.Cells(intUsedRowCount + 1, Trackscolumn.colBPO) = strBPO
.Cells(intUsedRowCount + 1, Trackscolumn.colCostCenter) = strCOCE
.Cells(intUsedRowCount + 1, Trackscolumn.colSOW) = strSOW
.Cells(intUsedRowCount + 1, Trackscolumn.colGroup) = strGroup
End With
Owb.Close True
Set Owb = Nothing
Set oExcel = Nothing
Else
Exit Sub
End If
Exit Sub
ErrorHandler:
If Owb Is Nothing Then
Else
Owb.Close False
End If
If oExcel Is Nothing Then
Else
Set oExcel = Nothing
End If
MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation
End Sub
Question 1> My current userform's Track button is a combo box. How do
I add values in the dropdown from the tracker's 'Project Tracker'
sheet to the dropdown.
I am calling the combobox "ComboBox1" in this example
The Range to place in the combobox would look like this...
The code to populate the combobox would be in the Userform Module.
Private Sub UserForm_Initialize()
Dim LstRw As Long
Dim Rng As Range
Dim ws As Worksheet
Set ws = Sheets("Project Tracker")
With ws
LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
End With
ComboBox1.List = Rng.Value
End Sub
Question 2> Once I add a new track in userform2
'ProjectTracksForm',submit and then when I come back to my current
userform 'OnboardingForm' that added track should be shown in the
dropdown of Track combo box
When you activate your userform again, you can clear the combobox and repopulate it with the new list.
Private Sub UserForm_Activate()
Dim LstRw As Long
Dim Rng As Range
Dim ws As Worksheet
Set ws = Sheets("Project Tracker")
With ws
LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
End With
ComboBox1.Clear
ComboBox1.List = Rng.Value
End Sub
I assume that somewhere you would have a code that will add a new item to the List in sheet("Project Tracker"),
Something like:
Private Sub CommandButton1_Click()
'THIS IS IN THE OTHER USERFORM
'add item to first blank cell in column A sheets("Project Tracker")
Dim sh As Worksheet
Dim LstRws As Long
Set sh = Sheets("Project Tracker")
With sh
LstRws = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(LstRws, 1) = "SomeThingNew" 'whatever you are adding to the list
End With
End Sub
The code will add something new to the list in your worksheet.
When you show the form again, the new item will be in the combobox.
You can either use a Button, Combobox event, textbox event, to add the item to the new list.

Update sheet with data from userform

I have a table and I have the form I built.
the user pick a name and surname from the table by the combobox in form
the user need to choose from combobox "yes/no" about this name
I need a vba code (excel) so that it can find the name (after the user picked it) in the table
and then update the yes/no column by the correct row.
I created a module and added this:
Option Explicit
Public Sub update_sheet(workername As String)
'--> If the user was selected on the form update column F to Yes
Dim ws As Worksheet
Dim rowno As Long
Set ws = Sheets("workers")
With ws
rowno = .Range("C:C").Find(workername).Row
.Cells(rowno, 6).Value = "Yes"
End With
End Sub
On the form code:
Private Sub cb_select_change()
Call update_sheet(cb_select.Value)
End Sub
where your combo box is called cb_select
You'll need to do some work on this to make it into what you need, but it should get you started:
Private Sub CommandButton1_Click()
Dim rng_ToSearch As Excel.Range
Dim rng_Found As Excel.Range
On Error GoTo ErrorHandler
'Change this to the range that contains your names. I'm assuming that
'it's a single column and has the Yes/No column alongside.
Set rng_ToSearch = Sheet1.Range("MyTable_Names")
'Change the What argument to reflect the name of your form's
'control.
Set rng_Found = rng_ToSearch.Find(What:=Me.ComboBox1.Value, _
After:=rng_ToSearch.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'This shouldn't happen if you've populated the name selection
'box correctly and have not allowed users to add to it.
'This is left as an exercise for the reader.
If rng_Found Is Nothing Then
Err.Raise vbObjectError + 2000, , "Either the selected name was " _
& "not found in the list, or no selection was made."
End If
'Again, change the control name to your own.
rng_Found.Offset(0, 1) = Me.ComboBox2.Value
ExitPoint:
On Error Resume Next
Set rng_ToSearch = Nothing
Set rng_Found = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error in updating users: " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub
THIS IS MY CODE SO FAR
Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As msforms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As msforms.fmDragState, Effect As msforms.fmDropEffect, ByVal Shift As Integer)
End Sub
Private Sub ClsFrmE_Click()
Unload Me
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("workers")
'???รท? ?? ?????? ?????
If Trim(Me.cmbWN.Value) = "" Then
Me.cmbWN.SetFocus
MsgBox "???? ?? ????"
Exit Sub
End If
If Trim(Me.tbDate.Value) = "" Then
Me.tbDate.SetFocus
MsgBox "???? ????? ?????"
Exit Sub
End If
'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With ws
' .Unprotect Password:="password"
If Trim(Me.dNdcmb.Value) = "????" Then
.Cells(lRow, 6).Value = 1
Else
.Cells(lRow, 6).Value = 0
End If
.Cells(lRow, 7).Value = Me.tbDate.Value
'.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
' .Protect Password:="password"
End With
'clear the data
Me.cmbWN.Value = ""
Me.tbDate.Value = ""
Me.cmbWN.SetFocus
ActiveWorkbook.Save
End Sub
Private Sub UserForm_Initialize()
Dim cFullName As Range
Dim cDnd As Range
Dim ws As Worksheet
Set ws = Worksheets("workers")
For Each cFullName In ws.Range("??????")
With Me.cmbWN
.AddItem cFullName.Value
.List(.ListCount - 1, 1) = cFullName.Offset(0, 1).Value
End With
Next cFullName
For Each cDnd In ws.Range("??????????")
With Me.dNdcmb
.AddItem cDnd.Value
End With
Next cDnd
Me.dNdcmb.Text = Me.dNdcmb.List(Me.dNdcmb.ListCount - 2)
Me.cmbWN.SetFocus
End Sub