I have a user form with three comboboxes and one text box that I would like to populate with named ranges or public variables. I am working in Excel 2010 on Windows. Here is what I have:
First I run through some code that converts one worksheet into a new configuration. I then call the userform which will set up the variables necessary to update the worksheet further. I have done this on a Mac and it works, but I am transitioning this from the mac to a windows server. I thought this would be the easy part but it in not working for some reason.
Here is the code for the userform.
Public KorS As String
Public ActivityID As String
Public Stage As String
Public varsaveme As String
Private Sub ufStageDt_Initialize()
AD = varsaveme & ".xls"
duh = KorS
Set Me.tbAdName.Text = duh
Set UserForm1.Caption = AD
'Set Me.cmbLowDt.List = "AnnDt"
Set Me.cmbHighDt.List = "AnnDt"
Set Me.cmbStage.List = "Stage"
Me.cmbLowDt.List = "AnnDt"
End Sub
The public variables are present in the code on the worksheet.
Here is the code that I used on the Mac.
Private Sub UserForm_Initialize()
Ad = varsaveme & ".xls"
duh = KorS
tbAdName.Text = varsaveme
UserForm.Caption = Ad
cmbLowDt.List = Range("AnnDt").Value
cmbHighDt.List = Range("AnnDt").Value
cmbStage.List = Range("Stage").Text
End Sub
Any assistance would be greatly appreciated. I am using the ufStageDt.Show command in the vba script to bring up the userform.
Set won't work, so eliminate that. Also, List expects an array. For a single hard-coded item, use Additem.
Me.cmbHighDt.Additem "AnnDt"
EDIT: "AnnDt" is a named range:
Me.cmbHighDt.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
EDIT2: For dates:
Private Sub UserForm_Initialize()
Dim i As Long
With Me.cmbHighDt
.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
For i = 0 To .ListCount - 1
.List(i) = Format(.List(i), "yyyy-mm-dd")
Next i
'to get it back to a date
ActiveSheet.Range("B1") = DateValue(.List(0))
End With
End Sub
Related
Edit : Sorry i forgot to mention that is VBA for Excel
First time i post on this sub reddit. I would like to something very simple, yet I have no heckin idea how to do it.
Let me give you a bit of context : In my company we have a standard model tool, which uses a standard excel file as input.
When you want to update your inputs from an old template, you download a standard file from a platform, and use a sub that doesn't take any arguments (called "upgrade engine"). Wen you call Upgrade engine, there is a file dialog tab that opens, and helps you select the source file you want to upgrade.
I am in a testing team for the standard model and i have to create a lot of templatse for each new release of the model for non regression testing purpose. So i would like to automatize the process. I cannot , and this is the important detail here, change the code of the standard template.
So i created a kind of masterfile with all my non regression test use cases, their address etc to update them one by one.
Here is my current code:
Public gParamTab As Variant
Public gHypTab As Variant
Public gSourcefolder As String
Public gBlankFolder As String
Public gTgtfolder As String
Public Const gParamTabColUseCase As Byte = 1
Public Const gParamTabColTTtgt As Byte = 2
Public Const gParamTabColTTSource As Byte = 3
Public Const gParamTabColFlagRetrieve As Byte = 4
Public Const gParamTabColTTCase As Byte = 5
Public Const gParamTabColFlagUpgrade As Byte = 6
Public Const gBlankTTName As String = "Table_Template_MVP_case"
Public Const gExtension As String = ".xlsb"
Sub init()
gParamTab = Sheets("Parameters").Range("gParamTab")
gHypTab = Sheets("NDD HYP").Range("gHypTab")
gSourcefolder = Sheets("Parameters").Range("gSourcefolder")
gTgtfolder = Sheets("Parameters").Range("gTgtfolder")
gBlankFolder = Sheets("Parameters").Range("gBlankFolder")
End Sub
Sub updateTT()
Call init
Dim lFullname_blank As String, lFullname_source As String, lFullname_tgt As String
Dim lGlobalrange As Variant
Dim lGlobaltable() As Variant
Dim lBlankTT As Workbook
Dim lLastRow As Long
Dim lSearchedVariable As Variant
Dim lBlankTTupgradeengine As String
lcol = 2
For lUsecase = 2 To UBound(gParamTab, 1)
If gParamTab(lUsecase, gParamTabColFlagUpgrade) = 1 Then
lFullname_blank = gBlankFolder & "\" & gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension
lFullname_source = gSourcefolder & "\" & gParamTab(lUsecase, gParamTabColTTSource) & gExtension
lFullname_tgt = gTgtfolder & "\" & gParamTab(lUsecase, gParamTabColTTtgt) & gExtension
Set lBlankTT = Workbooks.Open(lFullname_blank)
lBlankTTupgradeengine = gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension & "!UpgradeEngine.UpgradeEngine"
Application.Run lBlankTTupgradeengine
End If
Next
End Sub
So i come the main issue, how can I, from another macro, after the statement "Application.Run lBlankTTupgradeengine" , the upgrade engine macro starts, and calls the following function embedded in the "BlankTT" :
Sub UpgradeEngine()
Set wkb_target = ThisWorkbook
Set wkb_source = macros_Fn.Open_wkb()
[...]
Function Open_wkb() As Workbook
Dim fileName As Variant
With Application.FileDialog(msoFileDialogFilePicker)
' Makes sure the user can select only one file
.AllowMultiSelect = False
' Filter to just keep the relevants types of files
.filters.Add "Excel Files", "*.xlsm; *.xlsb", 1
.Show
' Extact path
If .SelectedItems.Count > 0 Then
fileName = .SelectedItems.Item(1)
Else
End
End If
End With
If (fileName <> False) Then
Set Open_wkb = Workbooks.Open(fileName:=fileName, IgnoreReadOnlyRecommended:=False, Editable:=False, ReadOnly:=True, UpdateLinks:=False)
Else
MsgBox "This file is already open. Please close it before launching the function."
End
End If
End Function
This function opens as I said before, a dialog box with a brows button to select the excel spreadsheet to use as ssource.
My question is, how can i fill automatically this Filedialog from my code, without changing the code of the standard excel file?
Thanks a lot for your help!
I tried to search everywhere but i did not find anything about this situation.
I'm trying to move a copy of the upgrade engine, but with an argument in the sub instead of the filedialog but the macro is too complex ..
Your best bet would be to add an optional parameter to UpgradeEngine - something like:
Sub UpgradeEngine(Optional wbPath as String = "")
'...
Set wkb_target = ThisWorkbook
If Len(wbPath) > 0 Then
Set wkb_source = Workbooks.Open(wbPath) 'open using provided file path
Else
Set wkb_source = macros_Fn.Open_wkb() 'open user-selected file
End If
'...
'...
Then you can call it and pass in the path you want.
FYI the code in Open_wkb seems off (at least, the "already open" message seems wrong). fileName <> False only checks if the user made a selection: it doesn't indicate anything about whether a selected file is already open or not.
How would you save or update a TextBox with its own value the user has inputted?
Example, I have a Userform with a TextBox for "password". Every user who opens the file will enter his own password in that TextBox, then save the file and reopen at any given time.
Note, the value should be saved permanently in that file (not only session based), so even after completely closing and reopening the file, the users password should be there in the Textbox until its changed again.
Passing the value to cell isn't a good idea, since its a password and shouldn't be visible.
I used so far below code, to no avail.
In the UF code for "Save" button:
Private Sub CommandButton1_Click()
SavePWStrings
Me.Hide
End Sub
In the standard module:
Public Sub SavePWStrings()
Dim pw As String
pw = UserForm1.TextBox1.Value
UserForm1.TextBox1 = pw
End Sub
Goal is to update the value of the TextBox programmatically as below.
Thanks
As I mentioned in the comments, here is an unusual way to achieve what you want. You can store the username/password in the module.
Module Setup
Insert a Module. Let's call it MyModule. Paste the below code there
Option Explicit
Private Sub UserDatabase()
'USER|sid_sid_sid|PASSWORD
'
'
'
End Sub
NOTE: Not that it matters but to make it look concise and manageable, ensure that there are no blank lines after End Sub.
|sid_sid_sid| is a separator that I am using to seperate the user from the password. Feel free to change that. Ensure that it is a unique text.
Userform Setup
And let's say your userform looks like this
Paste this code in the userform code area. The name of the textbox is txtPassword
Option Explicit
Dim proj As VBIDE.VBProject
Dim comp As VBIDE.VBComponent
Dim codeMod As VBIDE.CodeModule
Dim lineCount As Long
Dim i As Long
Dim doNotReEnter As Boolean
Dim oldPassword As String
Dim newPassword As String
'~~> Separator for Username / Password
Private Const MySep As String = "|sid_sid_sid|"
'~~> Userform Initialize Event
Private Sub UserForm_Initialize()
Dim currentUser As String
'~~> Get the username
currentUser = Environ("UserName")
lblUser.Caption = "USER :" & currentUser
'~~> Check if user exists
If DoesUserExist(currentUser) Then
'~~> If it does then get the password
txtPassword.Text = GetUserPassword(currentUser)
oldPassword = txtPassword.Text '<~~ Store current password in a variable
End If
End Sub
'~~> Login button
Private Sub CommandButton1_Click()
'~~> Get the password from the textbox
newPassword = txtPassword.Text
'~~> Check if they match. If they do then do not store else store
If newPassword <> oldPassword And Len(Trim(newPassword)) <> 0 Then
Dim modLine As String
modLine = " '" & Environ("UserName") & MySep & txtPassword.Text
Set proj = ThisWorkbook.VBProject
Set comp = proj.VBComponents("MyModule")
Set codeMod = comp.CodeModule
codeMod.InsertLines codeMod.CountOfLines - 1, modLine
End If
End Sub
'~~> Function to check if the user is there in the module
Private Function DoesUserExist(xlUser As String) As Boolean
Set proj = ThisWorkbook.VBProject
Set comp = proj.VBComponents("MyModule")
Set codeMod = comp.CodeModule
lineCount = codeMod.CountOfLines
For i = 1 To lineCount
If codeMod.Find(xlUser, i, 1, -1, -1) Then
DoesUserExist = True
Exit For
End If
Next i
End Function
'~~> Function to get the password for a user
Private Function GetUserPassword(xlUser As String) As String
Set proj = ThisWorkbook.VBProject
Set comp = proj.VBComponents("MyModule")
Set codeMod = comp.CodeModule
lineCount = codeMod.CountOfLines
For i = 1 To lineCount
If codeMod.Find(xlUser, i, 1, -1, -1) Then
GetUserPassword = Split(codeMod.Lines(i, 1), MySep)(1)
Exit For
End If
Next i
End Function
Basic Setup
In VBE, click on TOOLS|REFERENCES and check the Microsoft Visual Basic for Applications Extensibility 5.3 as shown below
Enable trust access to the VBA project object model. Click FILE | OPTIONS. In the navigation pane, select TRUST CENTER. Click TRUST CENTER SETTINGS. In the navigation pane, select MACRO SETTINGS. Ensure that Trust access to the VBA project object model is checked. Click OK.
Now if you notice that this will work when the VBA Project is Unprotected. So how do we make it work when the VBA project is Locked. For that, use the code from HERE. Port all that code inside the userform and do not keep that code in the module.
For additional security, you can encrypt the data before storing it in a module. Lot of examples in the web on how to encrypt/decrypt a string in VBA.
For demonstration purpose, I have VBA unlocked.
Sample File: The file can be downloaded from HERE
I have created a tool using Excel to gather inputs from a user and use it to do some processing of data. I have created a UI on a worksheet with a bunch of ActiveX controls (TextBox, ListBox, ComboBox).
Part of the ActiveX controls are dynamic - they are added at run time based on "metadata" that the tool admin creates on a second worksheet. Metadata contains the field name, type of ActiveX control, position of the control, ListRange to populate values, Multi-Text/Multi-Select flag, etc.
I am able to successfully add the ActiveX controls to the UI worksheet. However, now I want to add functionality for ActiveX TextBox controls to show a default text, when the control gets focus - default text gets removed, when the control loses focus - if user has entered any data it remains otherwise the default text shows up again.
Public Sub df_segment_GotFocus()
Dim wb As Workbook
Set wb = ThisWorkbook
Set form_sheet = Worksheets(Sheet1.Name)
If form_sheet.OLEObjects("df_segment") Is Nothing Then
Else
'When user begins to type, remove the help text and remove Italics
Dim seg_val As String
seg_val = form_sheet.OLEObjects("df_segment").Object.Value
If seg_val = "e.g. Desktop-Mac,Desktop-Win,Mobile-OSX" Then
form_sheet.OLEObjects("df_segment").Object.Font.Italic = False
form_sheet.OLEObjects("df_segment").Object.Value = ""
Else
form_sheet.OLEObjects("df_segment").Object.Value = seg_val
End If
End If
End Sub
Public Sub df_segment_LostFocus()
Dim wb As Workbook
Set wb = ThisWorkbook
Set form_sheet = Worksheets(Sheet1.Name)
If form_sheet.OLEObjects("df_segment") Is Nothing Then
Else
'Incase user doesn't enter any values, show the help text again
Dim seg_val As String
seg_val = form_sheet.OLEObjects("df_segment").Object.Value
If seg_val = "" Then
form_sheet.OLEObjects("df_segment").Object.Font.Italic = True
form_sheet.OLEObjects("df_segment").Object.Value = "e.g. Desktop-Mac,Desktop-Win,Mobile-OSX"
Else
form_sheet.OLEObjects("df_segment").Object.Value = seg_val
End If
End If
End Sub
In the sample code above, you can see that I am using the exact name of the control to setup the GotFocus and LostFocus event handlers. However, since my UI is metadata driven, the controls will be added/removed dynamically and I wouldn't know the name of the controls to explicitly add the event handlers.
I looked up the forums and implemented this:
a.) Implemented a Class Module
Public WithEvents df_TextBox As MSForms.TextBox
Public df_TextBox_Name As String
Private Sub df_TextBox_Change()
Dim wb As Workbook
Set wb = ThisWorkbook
Set form_sheet = Worksheets(Sheet1.Name)
Set metadata_sheet = Worksheets(Sheet2.Name)
Dim obj_name As String
obj_name = df_TextBox_Name
obj_val = form_sheet.OLEObjects(obj_name).Object.Value
MsgBox "Change in TextBox" & obj_val
End Sub
b.) Created objects for the Class where I instantiate the control objects
ElseIf d_Type = "TextBox" Then
df_obj.Object.Value = d_def_val
df_obj.Object.Font.Italic = True
If d_Multi = 1 Then
df_obj.Object.MultiLine = True
End If
'--------------------------------------------------------------
'part where we add the custom events for GotFocus and LostFocus
'--------------------------------------------------------------
ReDim Preserve TextBox_Event_Array(1 To i)
Set TextBox_Event_Array(i).df_TextBox = df_obj.Object
TextBox_Event_Array(i).df_TextBox_Name = df_obj.Name
Problem Statements
1.) When I create the class module, I don't see the GotFocus and LostFocus events available. Only Change, KeyDown/Press/Up, MouseDown/Move/Up
2.) I created a Change event handler just to test the Class Module but I do not see it getting triggered.
Any suggestions on how can I fix the problem or any alternate solutions?
It is very simple but yet I can't figure it out. Maybe because it cannot be done? Regardless here we go:
I would like to use a combobox that will, when selected, input cells with text values, functions and reference to external cells.
First line of the options would be to have the name populated.
Second line is a formula that would change from course to course.
Third line would provide a cell with a reference to another cell's content from another file. So if multiple course file are used I can have one master file that if I change the content of a cell the change will reflect on all the course file cells that are referring to it once updated.
This is in crude code form what I would like it to perform.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "ITCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "ITCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>70,"Prep Week",IF(V9>65,"Week 1",IF(V9>60,"Week 2",IF(V9>55,"Week 3",IF(V9>50,"Week 4",IF(V9>45,"Week 5",IF(V9>40,"Week 6",IF(V9>35,"Week 7",IF(V9>30,"Week 8",IF(V9>25,"Week 9",IF(V9>20,"Week 10",IF(V9>15,"Week 11",IF(V9>10,"Week 12",IF(V9>5,"Week 13",IF(V9>0,"Week 14")))))))))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[ITcourse.xlsx]Sheet'!$A$3
End If
If Me.ComboBox1.Value = "HRCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "HRCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>40,"Prep Week",IF(V9>35,"Week 1",IF(V9>30,"Week 2",IF(V9>25,"Week 3",IF(V9>20,"Week 4",IF(V9>15,"Week 5",IF(V9>10,"Week 6",IF(V9>5,"Week 7",IF(V9>5,"Week 8")))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[HRcourse.xlsx]Sheet'!$A$3
End If
End Sub
Thank you!
You need a function that returns the number of weeks for any given course name. This function should use a Dictionary to store the information, and the dictionary may be loaded from a dedicated worksheet.
Function WeeksPerCourse(courseName As String) As Long
Static dict As Scripting.Dictionary
If dict Is Nothing Then
' Fill the dictionary here. Note that it is better
' to load the values from a dedicated, hidden worksheet
Set dict = CreateObject("Scripting.Dictionary")
dict("ITCourse") = 14
dict("HRCourse") = 8
' Etc...
End If
WeeksPerCourse = dict(courseName)
End Function
With this function available, your procedure can be simplified like follows:
Private Sub ComboBox1_Change()
Dim course As Sting: course = Trim(ComboBox1.value)
Worksheets("PARADE STATE").Range("I1").value = course
'Dim nWeek As Long
'nWeek = WeeksPerCourse(course) - Worksheets("PARADE STATE").Range("V9").value / 5
'Worksheets("Data Base").Range("C1").value = IIf(nWeek < 1, "Prep Week", "Week " & nWeek)
Worksheets("Data Base").Range("C1").Formula = "= ""Week "" & INT((WeeksPerCourse('PARADE STATE'!I1) - 'PARADE STATE'!V9)/5)"
Worksheets("Week 1").Range("B2").Formula= "='N:\ITcourse\00 - Data Base\[" & course & ".xlsx]Sheet'!$A$3"
End Sub
I have these
Public Const WS1 = "SheetNameA"
Public Const WS2 = "SheetNameB"
Public Const WS3 = "SheetNameC"
Public Const WS4 = "SheetNameD"
Public Const WS5 = "SheetNameE"
Public Const WS6 = "SheetNameF"
Where SheetNameA-B-C are the names of sheets in a workbook.
And I would like to activate worksheets one after the other using a For loop 1 to 6like so:
For i = 1 to 6
Workbooks([wbkname]).Sheets(WS & i).Activate
[some more code doing stuff]
Next i
Now I know that doesn't work, I'm just trying to explain what I want.
Is that possible? To call a public constant by a concatenated name (to make that public constant string the name of the sheet we're activating)?
I hope that makes sense.
Edit: On second thought, maybe I'll just do a Select Case, which I know is not pretty, but I think, will be fine for my purpose.
For i = 1 to 6
Select Case i
Case 1
somevariable = [name of one sheet]
Case 2
somevariable = [name of another sheet]
....
End Select
Workbooks([wbkname]).Sheets(somevariable).Activate
Just use an array. First run MAIN(), then run marine():
Public WS(1 To 6) As String
Sub MAIN()
WS(1) = "SheetNameA"
WS(2) = "SheetNameB"
WS(3) = "SheetNameC"
WS(4) = "SheetNameD"
WS(5) = "SheetNameE"
WS(6) = "SheetNameF"
End Sub
Sub marine()
For i = 1 To 6
Workbooks("Book1").Sheets(WS(i)).Activate
[some more code doing stuff]
Next i
End Sub
I'm not aware of an "indirect" function in VBA, what you can do is to define a public array and store the values there, here you can get the values by index. As its not possible to define array constants in VBA you need to initialize your array before use (e.g. In the workbook's load event).