Private Sub ComboBox1_DropButtonClick()
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For N = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(N).Name
Next N
End Sub
I'm new to VBA so please bear with me. I may not be doing this the best way to begin with.
The code is taking the names of each sheet in my workbook (with the exception of the last sheet) and adding them to a combobox list. At first, each time I clicked the drop down, all sheet names were being added again making the list continue to grow with every click. My remedy was to clear the combobox first on each click and repopulate.
However, with the clear option being used, the value is not being displayed when making my selection. It displays fine when not using the clear option. Everything else still works, but I need it to show the selected value so users aren't confused.
Is there a better way to accomplish what I need?
EDIT: If it matters, this is not in a user form, it's just a active x combobox located directly on a worksheet.
this is a very strange behavior - but the DopButtonClick event is triggered again when you select the item in the list. Therefore, the value that was just assigned get cleared upon the .Clear in the second run.
This code fixes it:
Private Sub ComboBox1_DropButtonClick()
Dim strValue As String
Dim n As Integer
strValue = ComboBox1.Value
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For n = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(n).Name
Next n
ComboBox1.Value = strValue
End Sub
Something like below would work. However, I'd question why you'd want to repopulate the combobox everytime someone clicks on it. Why not do it when the workbook opens or the worksheet is activated?
Private Sub ComboBox1_DropButtonClick(ComboBox1 As ComboBox)
Dim strSelected As String
If ComboBox1.ListIndex > -1 Then
strSelected = ComboBox1.List(ComboBox1.ListIndex)
End If
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For N = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(N).Name
If strSelected = ActiveWorkbook.Sheets(N).Name Then
ComboBox1.ListIndex = N - 1
End If
Next N
End Sub
Very nice solution Peter.
In my case I have a list of items that can change between two combobox runs. If the selected combobox item is not anymore in the combo list, at the next run, the line:
ComboBox1.Value = strValue
throws an error .
I've found that declaring a public index:
Public nr As Integer
and making a count inside the combobox code in order to run .clear only once per button action makes this working independently of the list update:
Private Sub ComboBox1_DropButtonClick()
Dim n As Integer
If nr = 0 Then
ActiveSheet.ComboBox1.Clear
nr = 1
Else
nr = 0
End If
For n = 1 To ActiveWorkbook.Sheets.count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(n).Name
Next n
End Sub
Related
So, Listbox1 is populated (from another sub, linked to range of cells in the workbook) and users can select (one at a time) items from that Listbox to be shown in Listbox2, using a Command Button (Add) to move them. I've nearly managed to get it perfect. My problem is that if a user only selects the final entry in Listbox1, all other possible entries in Listbox1 are removed (blanked out/not visible/cannot be selected).
I want only the entry which has been selected from Listbox1 to be removed from Listbox1 as it appears in Listbox2.
Here's the code:
Private Sub Add_Click()
Dim i as Integer
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(i)
End If
Next i
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox1.RemoveItem i
End If
Next
End Sub
If there's anything obvious here, I'm really sorry. But these Listboxes have been driving me crazy for about 3 days now.
Thanks in advance
It's a single-select list, so try adding Exit For inside each loop once you've hit the selected item:
Private Sub Add_Click()
Dim i as Long
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(i)
Me.ListBox1.RemoveItem i
Exit For
End If
Next
End Sub
Why doesn't this code open the form with the items selected already? I set the selection flag to true with this code.
Private Sub UserForm_Initialize()
Dim i, InStrRes, k
With ActiveCell
If .Value <> "" Then
For i = 0 To Me.lstDV.ListCount - 1
InStrRes = InStr(1, ActiveCell.Value, Me.lstDV.List(i))
If InStrRes <> 0 And InStrRes <> Null Then
Me.lstDV.Selected(i) = True
End If
Next i
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim i, InStrRes, k
With ActiveCell
If .Value <> "" Then
For i = 0 To Me.lstDV.ListCount - 1
Me.lstDV.Selected(i) = False '<~~ add this code. Should be set to false in advance.
InStrRes = InStr(1, ActiveCell.Value, Me.lstDV.List(i))
'If InStrRes <> 0 And InStrRes <> Null Then
If InStrRes Then
Me.lstDV.Selected(i) = True
End If
Next i
End If
End With
End Sub
The presumption must be that the listbox hasn't been loaded at the time it is initialized. I tried the Activate event with similar lack of success. Please try this code instead.
Sub ShowMyForm()
Dim MyForm As New TryForm
Dim CellVal As Variant
CellVal = ActiveCell.Value
With MyForm
If Len(CellVal) Then
On Error Resume Next
.lstDV.ListIndex = Application.Match(CellVal, Range(.lstDV.RowSource), 0) - 1
End If
.Show
' code continues here when the form is closed
End With
Unload MyForm
End Sub
This code must be in a standard code module, not the form's code sheet. It calls the form TryForm (replace with the name you gave to your form), and modifies it before showing. Note that you still have full access to the form to take out values you may want after it is hidden. Just avoid Unload Me anywhere in the form's code because the unloading is done by the above code after you have taken everything you wanted.
Note that the form's Initialize event is triggered by the New key word in Dim MyForm As New TryForm, long before you gain access. The Activate event follows with some delay. Please make sure that the procedures you may run with these events don't interfere with what the above code does.
Is it possible to run a command inbetween the moment a user clicks on a listbox item (in a userform) and the item being selected?
I have a mask with a listbox as index and want to make it possible when a user goes to another item, the entries are automatically saved. At the moment I am doing it with a button but I want to prevent the situation that a user goes to a different item and loses all the information put in because he forgot to press the button.
my code if you click on the listbox:
Private Sub ListBox1_Click()
Dim lrow As Long
Values_delete 'Sub that clears all text boxes
If ListBox1.ListIndex >= 0 Then
lrow = 2
Do While Trim(CStr(Tabelle10.Cells(lrow, 1).Value)) <> ""
If ListBox1.Text = Trim(CStr(Tabelle10.Cells(lrow, 1).Value)) Then
Values_read (lrow) 'values get read from the excel cells and written into the text boxes
Exit Do
End If
lrow = lrow + 1
Loop
End If
End Sub
As well as my code for the save button:
Public Sub SaveButton_Click()
Dim lrow As Long
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(Abteilung.Text)) = "" Then
MsgBox "Error", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
lrow = 2
Do While Trim(CStr(Tabelle10.Cells(lrow, 1).Value)) <> ""
If ListBox1.Text = Trim(CStr(Tabelle10.Cells(lrow, 1).Value)) Then
Values_write (lrow) 'Values get written into the cells
If ListBox1.Text <> Trim(CStr(Abteilung.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lrow = lrow + 1
Loop
End Sub
Is this even possible?
Try MouseDown event that fires before updating anything. When you click on a new item,
.Selected or .Listindex points to the previous item within Mousedown. Then you can use MouseMove event to process the lately selected item.
I'm assuming you are using either an ActiveX control on your sheet OR a UserForm control so;
You can use the MouseDown event; below will print the text of the previously selected item (based on the user clicking a new item)
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Debug.Print ListBox1.Text
End Sub
MS Documentation breifly mentions this event: See here
I have a User Form in Excel in which questions are indexed in a Listbox control. Clicking on an item in the Listbox calls a Change event which populates other controls' values according to which item has been selected.
The user may change values within the text boxes. Upon changing them, a "Saved" flag gets set to False for that question. The user may then save the question into memory; or navigate away from the question.
If the user navigates away without saving (by means of clicking a different item in the Listbox), I want to present them with a warning - giving the option to either abandon their unsaved changes; or to remain with the current selection, and revert the Listbox selection which they just clicked.
If "Abandon changes" is selected, it works fine. However it runs into trouble when I try to revert the Listbox selection. I use an "EventsOn" Boolean to handle when the Change procedure should proceed, to avoid it calling itself. This seems to work, at the correct point in the code. However after EventsOn is reinstated, and after Exit Sub, it seems that the Change event is called again.
I do not know why the event is firing again. This results in the user being presented with the option a second time.
A lot of the following code has been stripped out because it relates to details of other form controls; loading/saving data from a database; and handling classes and dictionaries. However I have retained the relevant logic of the form controls:
Option Explicit
Dim NumberOfQuestions As Long
Dim EventsOn As Boolean
Dim SelectedListIndex As Long, CurrentQuestion As Long, QuestionSaved As Variant
Private Sub UserForm_Initialize()
' Stripped out lots of code here. Basically opens a recordset and loads values
ReDim QuestionSaved(1 To NumberOfQuestions) As Boolean
'
For X = 1 To NumberOfQuestions
lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
QuestionSaved(X) = True ' Flag the initial state as saved, for each question
If Not X = rst.RecordCount Then rst.MoveNext
Next X
'
' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
SelectedListIndex = 0
CurrentQuestion = 1
EventsOn = True
lbox_QuestionList.ListIndex = SelectedListIndex
End Sub
Private Sub lbox_QuestionList_Change()
' Ensure this event does NOT keep firing in a loop, when changed programmatically
If Not EventsOn Then Exit Sub
'
If Not QuestionSaved(CurrentQuestion) Then
If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
' Abandon changes = Yes
' Mark as saved
QuestionSaved(CurrentQuestion) = True
' Then proceed to change as normal
' (If the user comes back to this question, it will be re-loaded from memory in its original form)
' This works okay
Else
' Abandon changes = No
EventsOn = False ' So this sub is not called again
' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
lbox_QuestionList.ListIndex = SelectedListIndex
EventsOn = True
Exit Sub ' This should be the end of it. But somehow, it's not...
End If
End If
' Proceed with loading a new question according to the new selected ListIndex
SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
' ListIndex starts at zero, so we need to add 1
CurrentQuestion = SelectedListIndex + 1
ShowQuestion CurrentQuestion
End Sub
Private Sub ShowQuestion(QuestionNumber As Long)
' Stripped out code for brevity. Basically loads details from a dictionary of classes, and populates into textboxes
End Sub
Private Sub cb_Save_Click()
' Stipped out code. Takes values of current text boxes and saves them into a class in a dictionary
' Mark the current question as saved:
QuestionSaved(CurrentQuestion) = True
End Sub
''''''''''' Event handlers ''''''''''''''
Private Sub tb_Question_Change()
DoChange
End Sub
' Several other form controls have similar events: all calling "DoChange" as below
Private Sub DoChange()
If Not EventsOn Then Exit Sub
QuestionSaved(CurrentQuestion) = False ' Flag the current question as NOT saved, if any changes are made to form values
End Sub
Naturally, I have searched for this problem - but there are no answers so far which have assisted me:
Listbox events firing strangely - relates to C# and not VBA
listbox selected item changed event fired two times - relates to C# and not VBA
vba listbox event fires twice - suggests that a SetFocus method of the Listbox could solve the issue. However I have tried this, and the problem remains
The logic of my code seems sound. The mystery is why the Change event is being called a second time, even after Exit Sub.
(curses to OP for getting this problem in my brain!)
In my testing, I used the following UserForm:
The code below uses the ListBox1_AfterUpdate event, and I believe it may work for you.
Option Explicit
Private Const TOTAL_QUESTIONS As Long = 3
Private qSaved As Variant
Private selectedDuringTextboxChange As Long
Private eventsInProgress As Long
Private Sub ListBox1_AfterUpdate()
Debug.Print "listbox clicked, item " & (ListItemSelected() + 1) & " selected"
If eventsInProgress > 0 Then
Debug.Print " ... event in progress, exiting"
eventsInProgress = eventsInProgress - 1
Exit Sub
End If
If Not qSaved(selectedDuringTextboxChange) Then
Dim answer As VbMsgBoxResult
answer = MsgBox("Abandon changes?", vbYesNo + vbDefaultButton2)
If answer = vbYes Then
Debug.Print "yes, abandon the changes"
qSaved(selectedDuringTextboxChange) = True
Else
Debug.Print "nope, keep the changes"
'--- return to the previously selected list item
eventsInProgress = eventsInProgress + 1
UnselectAll
ListBox1.Selected(selectedDuringTextboxChange - 1) = True
ListBox1.ListIndex = selectedDuringTextboxChange - 1
End If
End If
End Sub
Private Sub QuitButton_Click()
Me.Hide
End Sub
Private Sub SaveButton_Click()
qSaved(ListBox1.ListIndex + 1) = True
End Sub
Private Sub TextBox1_Change()
selectedDuringTextboxChange = ListBox1.ListIndex + 1
qSaved(selectedDuringTextboxChange) = False
Debug.Print "changed text for question " & selectedDuringTextboxChange
End Sub
Private Sub UserForm_Initialize()
ReDim qSaved(1 To TOTAL_QUESTIONS)
selectedDuringTextboxChange = 1
With ListBox1
Dim i As Long
For i = 1 To TOTAL_QUESTIONS
.AddItem "Question " & i
qSaved(i) = True
Next i
.Selected(0) = True
End With
eventsInProgress = False
End Sub
Private Sub UnselectAll()
eventsInProgress = eventsInProgress + 1
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
.Selected(i) = False
Next i
End With
eventsInProgress = eventsInProgress - 1
End Sub
Private Function ListItemSelected() As Long
ListItemSelected = -1
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
If .Selected(i) Then
ListItemSelected = i
End If
Next i
End With
End Function
Private Sub WhichListItem_Click()
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
Debug.Print "listbox item(" & i & ") = " & .Selected(i)
Next i
End With
Debug.Print "eventsInProgress = " & eventsInProgress
End Sub
After looking into it for awhile, it appears that having the listbox set its own listindex from within its own change event (effectively recursively calling it) causes some weird backend issues. Fortunately, it's easy enough to deal with by migrating that bit out to its own function. After some experimenting, the best way to do it would be to create a function that clears and repopulates the listbox, so create this function in your UserForm code:
Private Function PopulateListbox(Optional ByVal arg_lSelected As Long = -1)
Me.lbox_QuestionList.Clear
Dim X As Long '
For X = 1 To NumberofQuestions
lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
QuestionSaved(X) = True ' Flag the initial state as saved, for each question
'If Not X = rst.RecordCount Then rst.MoveNext
Next X
Me.lbox_QuestionList.ListIndex = arg_lSelected
End Function
Now adjust your Initialize event to look like this (note that you need to define NumberofQuestions here, and then call the new function at the end to populate the listbox and select the first entry):
Private Sub UserForm_Initialize()
' Stripped out lots of code here. Basically opens a recordset and loads values
NumberofQuestions = 3 'This is where NumberofQuestions gets defined
ReDim QuestionSaved(1 To NumberofQuestions)
ReDim aAnswers(1 To NumberofQuestions)
'
' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
SelectedListIndex = 0
CurrentQuestion = 1
EventsOn = True
PopulateListbox SelectedListIndex 'Call the new function and set the 1st selection
End Sub
Lastly, update your listbox_change event to look like this (basically just outsourcing the setting of the listbox entry to the new function):
Private Sub lbox_QuestionList_Change()
' Ensure this event does NOT keep firing in a loop, when changed programmatically
If Not EventsOn Then Exit Sub
'
If Not QuestionSaved(CurrentQuestion) Or aAnswers(CurrentQuestion) <> Me.tb_Question.Text Then 'I added the second condition for testing purposes, may not be necessary in your full code
If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
' Abandon changes = Yes
' Mark as saved
QuestionSaved(CurrentQuestion) = True
' Then proceed to change as normal
' (If the user comes back to this question, it will be re-loaded from memory in its original form)
' This works okay
Else
' Abandon changes = No
EventsOn = False ' So this sub is not called again
' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
PopulateListbox SelectedListIndex 'Call your new function here
EventsOn = True
Exit Sub ' This should be the end of it. But somehow, it's not...
End If
End If
' Proceed with loading a new question according to the new selected ListIndex
SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
' ListIndex starts at zero, so we need to add 1
CurrentQuestion = SelectedListIndex + 1
ShowQuestion CurrentQuestion
End Sub
I had a problem with a Private Sub ListBox_Click() running twice.
When I cleared the ControlSource in the list box properties it fixed the problem. I had to add a line of code to specifically write the value from the listbox to the cell in the worksheet. At first the cell would not display the data so I set the range name to another cell and that was OK. So, I then dragged and dropped the new cell into the original location.
I don't understand where the problem originated, but the fix worked.
I had a similar unexpected issue, so maybe someone will find this result helpful.
Within a multi-selection-enabled Listbox_Change event, I checked the value of the currently-selected item to see whether it had been checked or unchecked.
Private Sub lstBox_Change()
With lstBox
If .Selected(.ListIndex) Then
' Call Method A.
Else
' Call Method B.
End If
End With
End Sub
When the list was checked, it would properly detect the selection and call A--but then, when stepping through the code and reaching the Change event's End Sub, the checkbox would automatically become unselected, and the Change event would fire again. Note that I wasn't setting any value in the ListBox itself; I was only checking to see whether the current item was checked or unchecked. But, somehow, that triggered it to unselect itself. (Also, this only seemed to happen on the first call to the Change event. Thereafter it behaved normally.)
I tried some of the other fixes, but BeforeUpdate and AfterUpdate never seemed to fire at all. The problem went away when I moved the selection test outside of the If statement and put the result into a Boolean instead:
Private Sub lstBox_Change()
With lstBox
BooleanResult = (.Selected(.ListIndex) = True)
If BooleanResult Then
' Call Method A.
Else
' Call Method B.
End If
End With
End Sub
After that, the ListBox consistently behaved as expected.
I have searched on the Internet for a few days but I still cannot find the way out. I would be really appreciated if I could get some hints from you guys here. Here is the details of what I am going to do:
I got a read-only Workbook called A, with a button 1 on it. By clicking button 1, a User-form containing a list-box and a button 2 with macro will pop out. The result will be printed on sheet 2 on workbook A.
What I want to do is that, using another workbook B, to call a VBA script to open workbook A and click button 1 for activate the User-form. Then,then select all the rows and run macro by clicking button 2. Finally, copy the value on sheet 2 to the workbook B.
To simplify the problem, I write some code to illustrate the case.
On Workbook A:
Button 1:
Public Sub Button1_Click()
UserForm1.Show
End Sub
Button 2:
Private Sub Button2_Click()
Dim y As Long, z As Long
z = 1
With Me.ListBox1
For y = 0 To .ListCount
On Error GoTo EH
If .Selected(y) = True Then
For i = 1 To ListBox1.ColumnCount
Sheets("Sheet2").Cells(z, i) = .List(y, i - 1)
Next i
z = z + 1
End If
Next y
End With
Unload Me
End
EH:
Unload Me
End Sub
UserForm:
Private Sub UserForm_Initialize()
ListBox1.Clear
With ListBox1
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "60;60;60"
.AddItem
.List(0, 0) = 1
.List(0, 1) = 2
.List(0, 2) = 3
.AddItem
.List(1, 0) = 4
.List(1, 1) = 5
.List(1, 2) = 6
End With
End Sub
On Workbook B, I do the following:
Sub selectsheet()
Application.Run Workbooks("WorksbookA").Worksheets("sheet1").Shapes("Button1").OnAction
ListBox1.Selected(1) = True
UserForm1.Button2_click
Worksheets("sheet2").range("A1:B3").copy
Workbooks("WorksbookB").Worksheets("sheet1").range("A1").select
selection.paste
End Sub
The vba seems fine because I could run it. But it sticks at the Application.Run. I am sorry that I am not a good at programming and also explaining this messy stuff. But I would be really appreciated if any of you could give a hand to me. Thanks.