I am wondering is there any solution to select / highlight every second pair in the list with some piece of code?
I have sat up listbox to MultiSelect:
And I want to achieve something like this:
By clicking button on UserForm:
Private Sub CommandButton1_Click()
' Select every second pair
End Sub
I have tried to play with:
Private Sub CommandButton1_Click()
' Select every second pair
sameCustomerComparison.Selected(1) = True
sameCustomerComparison.Selected(2) = True
sameCustomerComparison.Selected(5) = True
sameCustomerComparison.Selected(6) = True
End Sub
but it is giving an error... debugger pointing at sameCustomerComparison.Selected(1) = True
You could achieve this simply with a loop
Private Sub CommandButton1_Click()
Dim i As Long
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
For i = 0 To .ListCount - 1 Step 4
If i <= .ListCount Then .Selected(i) = True
If i + 1 <= .ListCount Then .Selected(i + 1) = True
Next i
End With
End Sub
Related
I need some help with getting the right code to do the following:
I have 4 groups of radio buttons inside a frame in a userform
Each group is a simple Yes/No radio button
I have a textbox that I want to autofill with a score range of A-D depending on the # of "yes" radio buttons selected.
The "No" checkboxes really shouldn't do anything in regards to the textbox
Userform Name = TP_UF
Frame Name = fun_opt_frame
Option Button Name for "Yes" = fun_score_yes1-4
Textbox Name = fun_scorebox
Logic:
4 Yesses = A
3 Yesses = B
2 Yesses = C
1 Yes = D
It doesn't matter what order the yesses are selected, its a total count. I tried using code using the frame but not sure if that is the best way. The frame for these radio buttons isn't needed for any reason other then to perhaps make it easier to code. So I could throw out the frame if it's not necessary to get this working.
I am not sure where to start here. Any help would be appreciated.
pic
The quickest and easiest way for you to understand is - I guess - the following code. You have to put the code into the class module of the userform.
Option Explicit
Dim opt1 As Byte
Dim opt2 As Byte
Dim opt3 As Byte
Dim opt4 As Byte
Private Sub opt1Yes_Click()
opt1 = 1
EvalOpt
End Sub
Private Sub opt1No_Click()
opt1 = 0
EvalOpt
End Sub
Private Sub opt2yes_Click()
opt2 = 1
EvalOpt
End Sub
Private Sub opt2No_Click()
opt2 = 0
EvalOpt
End Sub
Private Sub opt3yes_Click()
opt3 = 1
EvalOpt
End Sub
Private Sub opt3No_Click()
opt3 = 0
EvalOpt
End Sub
Private Sub opt4yes_Click()
opt4 = 1
EvalOpt
End Sub
Private Sub opt4No_Click()
opt4 = 0
EvalOpt
End Sub
Private Sub EvalOpt()
Dim sumOpt As Byte
Dim res As String
sumOpt = opt1 + opt2 + opt3 + opt4
Select Case sumOpt
Case 1: res = "D"
Case 2: res = "C"
Case 3: res = "B"
Case 4: res = "A"
Case Else: res = ""
End Select
Me.fun_scorebox.text = res
End Sub
I assumed the option buttons are named opt1Yes, opt1No, opt2Yes, opt2No etc.
A more advanced solution would probably be to use classe modules and "collect" the option buttons in such a way.
I ended up going about this differently and I got it working using a counter. Thanks for the help! Posting code here in case anyone else needs it.
Option Explicit
Private Sub OptionButton1_Change()
set_counter
End Sub
Private Sub OptionButton2_Change()
set_counter
End Sub
Private Sub OptionButton3_Change()
set_counter
End Sub
Private Sub OptionButton4_Change()
set_counter
End Sub
Private Sub OptionButton5_Change()
set_counter
End Sub
Private Sub OptionButton6_Change()
set_counter
End Sub
Private Sub OptionButton7_Change()
set_counter
End Sub
Private Sub OptionButton8_Change()
set_counter
End Sub
Private Sub set_counter()
Dim x As Integer, counter As Integer
Me.TextBox1.Value = ""
counter = 0
For x = 1 To 8 Step 2
If Me.Controls("OptionButton" & x).Value = True Then counter = counter + 1
Next x
Me.TextBox1.Value = Choose(counter, "D", "C", "B", "A")
End Sub
Private Sub UserForm_Activate()
Me.TextBox1.Value = ""
End Sub
Private Sub UserForm_Click()
Dim x As Integer
Me.TextBox1.Value = ""
For x = 1 To 8
Me.Controls("OptionButton" & x).Value = False
Next x
End Sub
I am stumped I tried the following and for the life of me I cant figure this out....Need to use a comand button on a listbox on an excel vba form.
Iniatilizing the form on load.....it load fine
Sub UserForm_Initialize()
UserForm1.LbNumbers.RowSource = "Sheet2!A1:A3"End Sub
Items display in listbox fine
I have a command button under the list box to select all the code
Sub CbSelectall_Click()
For i = 0 To LbNumbers.ListCount - 1
LbNumbers.Selected(i) = True
Next i
End Sub
If I click on button it jumps to the last line but it doesnt select all the numbers in the listbox. Can someone tell me how can I rectify it to select all the numbers in the listbox.Thank you
Private Sub lbTraderId_Change()
If ResetListBox(lbTraderId) Then
Exit Sub
ElseIf lbTraderId.Selected(0) Then
For i = 1 To lbTraderId.ListCount - 1
If lbTraderId.Selected(i) = False Then
lbTraderId.Selected(i) = True
End If
Next i
ElseIf lbTraderId.Selected(0) = False Then
For i = 1 To lbTraderId.ListCount - 1
If lbTraderId.Selected(i) = True Then
lbTraderId.Selected(i) = False
End If
Next i
End If
End Sub
Private Function ResetListBox(lbx As MSForms.ListBox) As Boolean
Dim x As Long
Static bExit As Boolean
If Not bExit Then
x = lbx.ListIndex
If x >= 0 And Not lbx Is Me.lbTraderId Then
bExit = True
lbx.Selected(x) = Not lbx.Selected(x)
bExit = False
ResetListBox = True
End If
End If
End Function
I want to write a value (1) into a desired cell within Excel 2007, when I select a checkbox. The checkbox is in a Visual Basic userform, not on the active sheet itself.
The value (1) must revert back to zero when the checkbox is not selected.
I managed to get it working, however, I have more than 300 check-boxes, and want to know how to create one code that will do it in a loop?
{
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b8").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b8").Value = 0
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b9").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b9").Value = 0
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b10").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b10").Value = 0
End If
End Sub
}
from checkbox 1 to checkbox 300, the cell range will be "B8" all the
way to "B308"
checkbox1 = cell range b8
checkbox2 = cell range b9
checkbox3 = cell range b10
checkbox4 = cell range b11
etc.......
Use IIf to set a value based on True or False.
Private Sub CheckBox1_Click()
ThisWorkbook.Sheets("sheet3").Range("B8").Value = IIf(CheckBox1.Value, 1, 0)
End Sub
Private Sub CheckBox2_Click()
ThisWorkbook.Sheets("sheet3").Range("B9").Value = IIf(CheckBox2.Value, 1, 0)
End Sub
Private Sub CheckBox3_Click()
ThisWorkbook.Sheets("sheet3").Range("B10").Value = IIf(CheckBox3.Value, 1, 0)
End Sub
I don't know how your workbook/userform looks in detail, but this should show pretty good how to do it:
First, we need the class which we will call Class1. In this class we put the code:
Option Explicit
Public WithEvents CBoxC As MSForms.CheckBox
Private Sub CBoxC_Change()
Dim i As Long
i = CLng(Replace(CBoxC.Name, "CheckBox", ""))
Sheet3.Cells(i + 7, 2).Value = 0 - CBoxC.Value
End Sub
Now we need a variable which "transfere" the events to our class. We jast add to any module:
Option Explicit
Public CBox() As New Class1
As the last step, we need to insert all the controls into our variable. So we add (or just include, if already there):
Option Explicit
Private Sub UserForm_Initialize()
Dim b As Variant
For Each b In Me.Controls
If TypeName(b) = "CheckBox" Then
If (0 / 1) + (Not Not CBox) = 0 Then ReDim CBox(0) Else ReDim Preserve CBox(UBound(CBox) + 1)
Set CBox(UBound(CBox)).CBoxC = b
End If
Next
End Sub
Instead of _Click we better use _Change. This way also keyboard-input will work...
As it is pretty much no code, it also should be self explaining. Just keep in mind, that such events will come last. (which should not matter in your case)
If you still have any questions, just ask ;)
Is it possible to use a listbox to change the order of rows in a worksheet? I have searched the Web for about an hour without ressults. I am using the following code for the task:
Private Sub UserForm_Initialize()
ListBox1.RowSource = "Sheet1!A1:A15"
End Sub
Option Explicit
Const UP As Integer = -1
Const DOWN As Integer = 1
Private Sub SpinButton1_SpinUp()
If Me.ListBox1.ListCount > 1 Then
Call MoveListItem(UP, Me.ListBox1)
End If
End Sub
Private Sub SpinButton1_SpinDown()
If Me.ListBox1.ListCount > 1 Then
Call MoveListItem(DOWN, Me.ListBox1)
End If
End Sub
Private Sub MoveListItem(ByVal intDirection As Integer, _
ByRef ListBox1 As ListBox)
Dim intNewPosition As Integer
Dim strTemp As String
intNewPosition = ListBox1.ListIndex + intDirection
strTemp = ListBox1.List(intNewPosition)
If intNewPosition > -1 _
And intNewPosition < ListBox1.ListCount Then
'Swap listbox items
ListBox1.List(intNewPosition) = ListBox1.Value
ListBox1.List(intNewPosition - intDirection) = strTemp
ListBox1.Selected(intNewPosition) = True
End If
End Sub
Hope somone can give me a hint!
UPDATE!!
What i want is, if I for example have these values in a column in my worksheet:
week1
week2
week3
week4
Then I would like to re-arrenge the order of these values with the SpinButton in the ListBox;
week2
week4
week1
week3
You most certainly can do that!
Here is a quick code that does this in general, I will leave it to you to place this where it is needed:
For i = 0 To ListBox1.ListCount - 1
ActiveWorkbook.Sheets("Sheet1").Range("A" & CStr(i + 1)).Value = ListBox1.List(i)
Next i
You'll probably need to change what is inside the for loop to better reflect your own code. For writing to a specific range just add whatever starting row number you want!
I have two ListBoxes. ListBox1 has list of items that can be selected by the user to transfer to ListBox2 by either double clicking the item or pressing the add button. What I want to do now is to prevent the user from adding duplicates in ListBox2. If ever a duplicate is detected a message will prompt "Item already included" and end the code. I am guessing this can be done with contains? But I have no idea how to do it. I have the following codes:
'Report Listing
Private Sub UserForm_Initialize()
'List of Reports
With ListBox1
.AddItem "Report 1"
.AddItem "Report 2"
.AddItem "Report 3"
.AddItem "Report 4"
.AddItem "Report 5"
.AddItem "Report 6"
End With
End Sub
'Add selection to ListBox2
Private Sub AddButton_Click()
With ListBox1
Dim itemIndex As Integer
For itemIndex = .ListCount - 1 To 0 Step -1
If .Selected(itemIndex) Then
ListBox2.AddItem .List(itemIndex)
End If
Next itemIndex
End With
End Sub
'Double click to Add
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.AddItem ListBox1.List(ListBox1.ListIndex)
End Sub
Something like this will hopefully help you..
AddValueListbox2 function checks for existence of a value, adds it if it's not there and alerts the user if it is.
NB
This will work if you have multi-select enabled for the list boxes.
Private Sub CommandButton1_Click()
'index is -1 if nothin is selected
If ListBox1.ListIndex = -1 Then Exit Sub
'loop backwards as we're removing items
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) Then
AddValueListbox2 ListBox1.List(i)
ListBox1.RemoveItem (i)
End If
Next i
End Sub
Private Function AddValueListbox2(str As String)
Dim valExists As Boolean
valExists = False
For i = 0 To ListBox2.ListCount - 1
If ListBox2.List(i) = str Then valExists = True
Next i
If valExists Then
MsgBox str & " has already been added to ListBox", vbInformation
Else
ListBox2.AddItem str
End If
End Function
Private Sub UserForm_Activate()
Dim items(2) As String
items(0) = "foo"
items(1) = "bar"
items(2) = "baz"
For i = LBound(items) To UBound(items)
Me.ListBox1.AddItem items(i)
Next i
End Sub
In case anyone is still interested, there's another way to do this, using a similar technique.
Sub Duplicate()
dim i as integer
dim x as integer
x = 0
For i = 0 to listbox2.count - 1
If listbox2.list(i) = myval Then
x = x + 1
End If
Next i
If x = 0 Then
listbox2.additem myval
End If
End Sub
Where myval is the selected value from listbox1.
Essentially if it finds a single reference to your value in the list, it will start a counter. If no instances of your value are found, it will insert it into the listbox.
Hope this helps someone.