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.
Related
#
updated codes
Function condition(ByRef objCmb As ComboBox)
If objCmb.Value ="" And objCmb.Value = "g" Then
Call MsgBox("gg", vbOKOnly, "error")
End If
End Function
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition (ComboBox1)
End Sub
'other codes for reference:
Private Sub CommandButton1_Click()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To 3
For j = 1 To 5
With Me.Controls("ComboBox" & (i - 1) * 5 + j)
If .Text <> "" Then
Cells(lastrow + i, j) = .Text
Else
Exit Sub
End If
End With
Next j
Next i
End Sub
I have 50 combo and text boxes in VBA user panel. As it is too troublesome to set constraints in every combo or text box, I want a function to apply to every combo and text box.
For the codes above , it shows up cant find objecterror
How to solve ?
Btw , how to set the function statement for textbox ?
is it Function condition2(ByRef objCmb As textbox)...
You are receiving an error because ComboBox is not ByRef objCmb As ComboBox. Don't use parenthesis when calling a sub. Don't use parenthesis when calling function if you are not using the functions return value. If a function does not return a value it should be a sub.
Sub condition(ByRef objCmb As MSForms.ComboBox)
If objCmb.Value <> "" And objCmb.Value = "g" Then
MsgBox "gg", vbOKOnly, "error"
objCmb.Value = ""
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I wrote a function to help you generate the Exit event code for all your text and combo boxes.
Sub AddCodeToCipBoard(frm As UserForm)
Const BaseCode = " Private Sub #Ctrl_Exit(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _
" condition ComboBox1" & vbCrLf & _
" End Sub" & vbCrLf & vbCrLf
Dim s As String
Dim ctrl
Dim clip As DataObject
Set clip = New DataObject
For Each ctrl In frm.Controls
If TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox" Then
s = s & Replace(BaseCode, "#Ctrl", ctrl.Name)
End If
Next
clip.SetText s
clip.PutInClipboard
End Sub
Put this code in a module and call it like this:
AddCodeToCipBoard Userform1
Now all the Exit event code will be copied into the Windows Clipboard. Go into your Userforms code module and paste the new code.
Example Output:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I have a vlookup userform which autofills the details in the form based on the seat n°.
Now I want to incoroporate a ref edit to paste these data from the text box to the cells the user chooses with the refedit. Hence i would need some help in going about these. This is the code i have used. I potentially want to insert 3 refedit boxes for user to select the cell they want to paste each of the data (Name,Dept and Ext No.) from the textbox.
See my code below:
Option Explicit
Private Sub Frame1_Click()
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim answer As Integer
answer = TextBox1.Value
TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
TextBox3.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 3, False)
TextBox4.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 4, False)
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox4_Change()
End Sub
Private Sub CancelButton_Click()
Unload Me
End
End Sub
I have tried figuring out a code to solve this issue but I am getting an object required error. My rngcopy would be textbox2.value (Name) and the rngpaste location would be the ref edit 1.
This is the code
Private Sub PasteButton_Click()
Dim rngCopy As Range, rngPaste As Range
Dim wsPaste As Range
Dim answer As Integer
answer = TextBox1.Value
If RefEdit1.Value <> "" Then
TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
Set rngCopy = TextBox2.Value
Set wsPaste = ThisWorkbook.Sheets(Replace(Split(TextBox2.Value, "!")(0), "'", ""))
Set rngPaste = wsPaste.Range(Split(TextBox2.Value, "!")(1))
rngCopy.Copy rngPaste
Else
MsgBox "Please select an Output range"
End If
End Sub
You should get the row index with Match and expose it to the form so it can be used by the copy function.
And to set the target pointed by a Ref control, just evalute the .Value property with Range():
Range(RefEdit.Value).cells(1, 1) = Worksheet.Cells(row, column)
The form:
The code:
' constants to define the data
Const SHEET_DATA = "L12 - Data Sheet"
Const COLUMN_SEAT = "B"
Const COLUMNN_NAME = "C"
Const COLUMN_DEPT = "D"
Const COLUMN_EXTNO = "E"
Private Sheet As Worksheet
Private RowIndex As Long
Private Sub TxtSeatNo_Change()
Dim seatno
'clear the fields first
Me.TxtName.value = Empty
Me.TxtDept.value = Empty
Me.TxtExtNo.value = Empty
RowIndex = 0
If Len(TxtSeatNo.value) Then
Set Sheet = ThisWorkbook.Sheets(SHEET_DATA)
On Error Resume Next
' get the seat number to either string or double
seatno = TxtSeatNo.value
seatno = CDbl(seatno)
' get the row index containing the SeatNo
RowIndex = WorksheetFunction.match(seatno, _
Sheet.Columns(COLUMN_SEAT), _
0)
On Error GoTo 0
End If
If RowIndex Then
' copy the values from the sheet to the text boxes
Me.TxtName.value = Sheet.Cells(RowIndex, COLUMNN_NAME)
Me.TxtDept.value = Sheet.Cells(RowIndex, COLUMN_DEPT)
Me.TxtExtNo.value = Sheet.Cells(RowIndex, COLUMN_EXTNO)
End If
End Sub
Private Sub BtCopy_Click()
If RowIndex < 1 Then Exit Sub
' copy the current values to the cells pointed by the ref controls
If Len(Me.RefName.value) Then _
Range(Me.RefName.value) = Sheet.Cells(RowIndex, COLUMNN_NAME)
If Len(Me.RefDept.value) Then _
Range(Me.RefDept.value) = Sheet.Cells(RowIndex, COLUMN_DEPT)
If Len(Me.RefExtNo.value) Then _
Range(Me.RefExtNo.value) = Sheet.Cells(RowIndex, COLUMN_EXTNO)
End Sub
Private Sub BtlClose_Click()
' close the form
Unload Me
End Sub
You are declaring your rngCopy as a Range Object and then later on you are binding it to a .value method of the range object.
Set rngCopy = TextBox2.Value
This is likely where you are encountering errors. Try declaring a string and assigning it to your copy value.
Dim string1 As String
string1 = TextBox2.Value
Step through your code editor with the LOCALS window open, and watch what happens to your rngCopy object when you assign a string to it.
So I've been working on a Holiday calendar for employees and I've got a problem which I cannot seem to find a solution for.
I have two buttons which are assigned to a VBA script and I'm having an issue with a holiday entry for it. I can't seem to be able to select a specific cell from the user form inputs to output the data. The code looks like this:
Private Sub ComboBox2_Change()
End Sub
Private Sub CommandButton1_Click()
Dim emptyRow As Long
'Make Sheet1 active
'Holiday Calendar.Activate
'Determine emptyRow
'ActiveCell = (A5)
'emptyRow = WorksheetFunction.CountA(Range("Employees")) + 1
NextRow = 5
Do Until Sheets("Holiday Calendar").Cells(NextRow, 4) = Username.Value
NextRow = NextRow + 1
Loop
'Transfer information
Cells(NextRow, 6).Value = TypeOfLeave.Value
Cells(NextRow, 5).Value = (EndDate.Value) + 1 - (StartDate.Value)
End Sub
Private Sub CommandButton2_Click()
Call UserForm_Initialize
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As
Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
'Empty UsernameTextBox
Username.Value = ""
'Empty TypeOfLeave ComboBox
TypeOfLeave.Clear
'Fill TypeOfLeaveComboBox
With TypeOfLeave
.AddItem "AL - Anual Leave"
.AddItem "WFH - Work From Home"
'.AddItem ""
End With
'Set Focus on UsernameTextBox
Username.SetFocus
End Sub
This is how the code for the whole user form looks.
Now what I need help with is when the user inputs the start and end date of their holiday it will then look for the username within the spreadsheet and place "AL-Anual Leave" and "WFH - Work From Home" accordingly in the dates that the user has provided.
So what I need is a piece of code that will find the date within the spreadsheet from the user form and input the values "Al" or "WFH"
If any of this is unclear please let me know and ill explain. I tried including pictures but don't have enough reputation so it's much harder. I can send the images in email if needed to explain better.
Based on our comments from above, I would like if you could give this code snippet a try first and let me know if it still isn't working.
Private Sub ComboBox2_Change()
End Sub
Private Sub CommandButton1_Click()
Dim emptyRow As Long
'Make Sheet1 active
'Holiday Calendar.Activate
'Determine emptyRow
'ActiveCell = (A5)
'emptyRow = WorksheetFunction.CountA(Range("Employees")) + 1
Username.Value = UsernameTextBox.Value
NextRow = 5
Do Until Sheets("Holiday Calendar").Cells(NextRow, 4) = Username.Value
NextRow = NextRow + 1
Loop
'Transfer information
Cells(NextRow, 6).Value = TypeOfLeave.Value
Cells(NextRow, 5).Value = (EndDate.Value) + 1 - (StartDate.Value)
End Sub
Private Sub CommandButton2_Click()
Call UserForm_Initialize
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As
Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
'Empty UsernameTextBox
Username.Value = ""
'Empty TypeOfLeave ComboBox
TypeOfLeave.Clear
'Fill TypeOfLeaveComboBox
With TypeOfLeave
.AddItem "AL - Anual Leave"
.AddItem "WFH - Work From Home"
'.AddItem ""
End With
'Set Focus on UsernameTextBox
Username.SetFocus
End Sub
I am creating a user form that does Customer Returns. I wish to have a (Status)column that will automatically update itself. It refers to the Arrival Date of the product. It works, but, when I change the system date, the status bar does not change. What do I have to do to make it update regularly? The following is the code of what ever is working.
P.S it the code works fine when entering the values. But doesn't self update
Option Explicit
Dim dDate As Date
Private Sub cbP_CodeCR_Change()
Dim row As Long
row = cbP_CodeCR.ListIndex + 2
End Sub
Private Sub Fill_My_Combo(cbo As ComboBox)
Dim wsInventory As Worksheet
Dim nLastRow As Long
Dim i As Long
Set wsInventory = Worksheets("Inventory")
nLastRow = wsInventory.Cells(Rows.Count, 1).End(xlUp).row ' Finds last row in Column 1
cbo.Clear
For i = 2 To nLastRow 'start at row 2
cbo.AddItem wsInventory.Cells(i, 1)
Next i
End Sub
Private Sub cmdCancel_Click()
Unload CustomerReturn
End Sub
Private Sub cmdEnter_Click()
Dim cust_ID As Integer
Dim prod_Code As Integer
Dim arr_date As Date
Dim stat As String
Dim status As String
Dim rowPosition As Integer
rowPosition = 1
Sheets("Customer Return").Select
Sheets("Customer Return").Cells(1, 1).Value = "Customer ID"
Sheets("Customer Return").Cells(1, 2).Value = "Product Code"
Sheets("Customer Return").Cells(1, 3).Value = "Arrival Date"
Sheets("Customer Return").Cells(1, 4).Value = "Status"
Do While (Len(Worksheets("Customer Return").Cells(rowPosition, 1).Value) <> 0)
rowPosition = rowPosition + 1
Loop
cust_ID = txtC_IDCR.Text
Sheets("Customer Return").Cells(rowPosition, 1).Value = cust_ID
prod_Code = cbP_CodeCR.Text
Sheets("Customer Return").Cells(rowPosition, 2).Value = prod_Code
arr_date = txtA_DateCR.Text
Sheets("Customer Return").Cells(rowPosition, 3).Value = arr_date
If ((arr_date - Date) <= 0) Then
Sheets("Customer Return").Cells(rowPosition, 4).Value = "Arrived"
Else
Sheets("Customer Return").Cells(rowPosition, 4).Value = "Waiting for Delivery"
End If
End Sub
Sub Recalc()
Range("C:C").Value = Format("dd/mm/yyyy")
Range("D:D").Calculate
Call StartTime
End Sub
Sub StartTime()
SchedRecalc = Now + TimeValue("00:00:10")
Application.OnTime SchedRecalc, "Recalc"
End Sub
Sub EndTime()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, _
Procedure:="Recalc", Schedule:=False
End Sub
Private Sub txtA_DateCR_AfterUpdate()
With txtA_DateCR
If .Text = "" Then
.ForeColor = &HC0C0C0
.Text = "dd/mm/yyyy"
End If
End With
End Sub
Private Sub txtA_DateCR_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Exit Sub
If Mid(txtA_DateCR.Value, 4, 2) > 12 Then
MsgBox "Invalid date, make sure format is (dd/mm/yyyy)", vbCritical
txtA_DateCR.Value = vbNullString
txtA_DateCR.SetFocus
Exit Sub
End If
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
txtA_DateCR.Value = Format(txtA_DateCR.Value, "dd/mm/yyyy")
dDate = txtA_DateCR.Value
End Sub
Private Sub txtA_DateCR_Enter()
With txtA_DateCR
If .Text = "dd/mm/yyyy" Then
.ForeColor = &H80000008
.Text = ""
End If
End With
End Sub
Private Sub UserForm_Initialize()
txtA_DateCR.ForeColor = &HC0C0C0
txtA_DateCR.Text = "dd/mm/yyyy"
cmdEnter.SetFocus
Fill_My_Combo Me.cbP_CodeCR
End Sub
Deeply appreciate any help if possible.
This should work in the most common scenario when time flows forward:
Create a utility module AnyNameIsGood with this code (it comes from Sean Cheshire's answer to similar question with the Recalc body adjusted)
Dim ScheduledRecalc As Date
Sub Recalc()
Sheets("Customer Return").Range("D:D").Calculate
Call StartTime
End Sub
Sub StartTime()
ScheduledRecalc = Now + TimeValue("00:00:10")
Application.OnTime ScheduledRecalc, "Recalc"
End Sub
Sub EndTime()
On Error Resume Next
Application.OnTime EarliestTime:=ScheduledRecalc, Procedure:="Recalc", Schedule:=False
End Sub
Add this code to the ThisWorkbook module to prevent unwanted behavior while closing the module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call EndTime
End Sub
In the CustomerReturn module (the form) change your current code to
Private Sub cmdEnter_Click()
' ...
arr_date = txtA_DateCR.Text
Sheets("Customer Return").Cells(rowPosition, 3).Value = arr_date
Sheets("Customer Return").Cells(rowPosition, 3).NumberFormat = "dd\/mm\/yyyy"
Sheets("Customer Return").Cells(rowPosition, 4).FormulaR1C1 = "=IF(DAYS(R[0]C[-1],TODAY())<=0,""Arrived"",""Waiting for Delivery"")"
End Sub
It will format the date cells and it will make the generated Status formulas sensitive to the Excel's Calculate Now (F9) event.
Somewhere (e.g. in the Workbook_Open event handler) call the StartTime utility procedure (once). It will trigger automatic recalculation of the Status column.
Steps 1, 2, 4 are optional and not needed if the refresh does not have to be automatic as the end user can refresh the statuses anytime by pressing F9
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