multiselect listbox value placement - excel

I need the values from a multi-select list-box to populate into different locations within a spreadsheet. Each selection needs to populate on a different row i.e. 1st selection B60, 2nd selection B68, 3rd selection B78.
I tried adding the below code to what I have, but get "Without if" error and "Next For" error:
I tried adding:
If Me.ALLAC.Selected(x) Then
Ck = 2
addme = Me.ALLAC.List(x)
addme.Offset(8, 1) = Me.ALLAC.List(x, 1)
addme.Offset(8, 2) = Me.ALLAC.List(x, 2)
Set addme = addme.Offset(1, 0)
Below is the current code as written
Private Sub cmdAdd2_Click()
'dimension the variable
Dim addme As Range
Dim x As Integer, Ck As Integer
'set variables
Set addme = sheet9.Range("B59").Offset(1, 0)
Ck = 0
'run the for loop
For x = 0 To Me.ALLAC.ListCount - 1
'add condition statement
If Me.ALLAC.Selected(x) Then
Ck = 1
addme = Me.ALLAC.List(x)
addme.Offset(0, 1) = Me.ALLAC.List(x, 1)
addme.Offset(0, 2) = Me.ALLAC.List(x, 2)
Set addme = addme.Offset(1, 0)
'clear the selected row
ALLAC.Selected(x) = False
End If
Next x
'send a message if nothing is selected
If Ck = 0 Then
MsgBox "There is nothing selected"
End If
End Sub
I'd like to see each selection in the multi-select list to go to specific cells within my spreadsheet.
But they are showing up one row after the next. i.e. B60, B61, B62.

I changed the Set addme=addme.offset (8,0) to move the second and third clicks down 8 rows from my first click. Perfect, simple fix, no more code needed. I was putting more into it then needed. Thank you Pawel for your input.

Related

loop through all comboboxes in userform and validate with name and make them visible

I have a userform in which pages and then on one page contain a lot of comboboxes all of them have a pattern in their name as per their location for example in first row I have 3 comboboxes their names are:
AO11, AO12, AO13
Second row has 04 comboboxes with following names
AO21, AO22, AO23, AO24
Third row has 04 Comboboxes with following names
AO31, AO32, AO33, AO34
and so on till 12~15 Comboboxes
X represents row number when which will start with X=1 because first row will always be visible.
once user press AddNewCMD it should make visible the next row of comboboxes with the following code:
Private Sub AddNewCMD_Click()
If X = 2 Then
Me.AO21.Visible = True
Me.AO22.Visible = True
Me.AO23.Visible = True
Me.AO24.Visible = True
X = X + 1
ElseIf X = 3 Then
Me.AO31.Visible = True
Me.AO32.Visible = True
Me.AO33.Visible = True
Me.AO34.Visible = True
X = X + 1
End If
End Sub
in AO21
2 represents row number
1 represent first combo in row two
however I realize that it will be very long code as if I add further rows in therefore I am search for a way that can loop through each comboboxes and validate x with its name and make them visible?
same goes for hiding the comboboxes.
Please, copy the next code in the userForm code module:
Option Explicit
Private nextRow As Long
Private Sub AddNewCMD_Click()
Dim i As Long, ctrl As MSForms.Control, boolVis As Boolean
If nextRow = 0 Then
nextRow = 2
Else
nextRow = nextRow + 1
End If
Debug.Print nextRow
For i = 0 To Me.MultiPage1.Pages(0).Controls.count - 1
Set ctrl = Me.MultiPage1.Pages(0).Controls(i)
If TypeOf ctrl Is MSForms.ComboBox Then
If CLng(Right(ctrl.Name, Len(ctrl.Name) - 2)) > 13 Then
Debug.Print ctrl.Name, ctrl.Visible
If CLng(Mid(ctrl.Name, 3, 1)) = nextRow Then
ctrl.Visible = True: boolVis = True
End If
End If
End If
Next i
If Not boolVis Then MsgBox "The row " & nextRow & " does not exist..."
End Sub
ClickingAddNewCMD button will make the next combos row visible. When the existing rows are all made visible, a message stating that no any row available will be raised.
You did not answer my clarification questions... But if only one such combo row should be visible (except the first one, or including), I can make a function to determine it, but this can be done only if you supply a logic algorithm based on what to proceed.

Adding data on excel sheet

I have a list of data like this:
I want to add tests from Column N to X bu using a userform.
in the userform i have a combobox populated like this:
For example if add test D for the 1st time it should be Added on column 3, if I add a 2nd test D it should be Added on column 4... If I add test A for the 1time it should be Added on column 1, the seconde test A should be Added on column 2.... (like in the 1st pic)
Each time the name of persons and service is added automatically.
I am trying to set a condition to be able to get what I want I've writen this code:
' code for the button on my worksheet
Private Sub CommandButton1_Click()
'-------------Populate the comobox of persons and tests
Dim ws_Liste_Pers As Worksheet
Set ws_Liste_Pers = ActiveWorkbook.Worksheets("service ")
Fin_Liste_Pers = ws_Liste_Pers.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_Pers
UserForm_SDE.ComboBox_Demandeur.AddItem ws_Liste_Pers.Range("A" & i)
Next i
Dim ws_tech_essais As Worksheet
Set ws_tech_essais = ActiveWorkbook.Worksheets(" tech essais")
Fin_Liste_tech_essais = ws_tech_essais.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_tech_essais
UserForm_SDE.ComboBox_Tech_Essai.AddItem ws_tech_essais.Range("A" & i)
Next
UserForm_SDE.Show
End Sub
'Code for the userfom to add the data
Private Sub CommandButton1_Click()
TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
ReDim TPlaces(0 To ComboBox_Tech_Essai.ListCount - 1)
Dim LP As Long, LS As Long, CS As Long
LP = ComboBox_Demandeur.ListIndex + 1
' If LP = 0 Then Exit Sub
' If Not ComboBox_Tech_Essai.MatchFound Then Exit Sub
CS = TPlaces(ComboBox_Tech_Essai.ListIndex) + 1: If CS < 14 Then CS = 14
TPlaces(ComboBox_Tech_Essai.ListIndex) = CS
On Error Resume Next
LS = WorksheetFunction.Match(TPers(LP, 3), Feuil2.[A:A], 0)
If Err Then LS = 0
On Error GoTo 0
If LS > 0 Then If Not IsEmpty(Feuil2.Cells(LS, CS).Value) Then LS = 0
If LS = 0 Then
LS = Feuil1.[A1000000].End(xlUp).Row + 1
Feuil1.Cells(LS, 1) = TPers(LP, 1)
' Feuil1.Cells(LS, 2) = TPers(LP, 2)
End If
Feuil1.Cells(LS, CS) = ComboBox_Tech_Essai.Value
Unload Me
End Sub
The problem is that this code is adding the tests only on column N.
Can anyone help me to find teh pb. Thank you
Use the next code, please. In order to properly work, it needs the strings matching the test numbers (from the sheet) to be exactly formatted like in the combo box I mean, like "001", "002" .... I did not observe how you loaded the combo, but it would be necessary to do the same for the range in H:H column. The best text format is obtained by selecting the column in discussion and then: Data tab -> Text to Columns... -> Next -> Next, then check 'Text' in 'Column data format' and press 'Finish':
Private Sub CommandButton1_Click()
Dim sh As Worksheet, rngTNo As Range, rngCol As Range, iRow As Long, i As Long
Dim ComboBox_No As MSForms.ComboBox, ComboBox_Test As MSForms.ComboBox
'use in the next row your real combo boxes. I named mine ComboBox_No, respectively, ComboBox_Test
'You will use something like: Me.ComboBox_Tech_Essai, Me.ComboBox_Demandeur...
Set ComboBox_No = frmTest.ComboBox_No: Set ComboBox_Test = frmTest.ComboBox_Test
Set sh = ActiveSheet 'Feuil2
Set rngTNo = sh.Range("H7:H" & sh.Range("H" & Rows.count).End(xlUp).Row) 'Test numbers range
If rngTNo.cells.count < 1 Then MsgBox _
"There necessary Test numbers range is missing...": Exit Sub
If rngTNo.NumberFormat <> "#" Then MsgBox _
"The Test numbers range must be formatted as text!": Exit Sub
iRow = rngTNo.Find(ComboBox_No.Value).Row 'row to be used for dropping the test
For i = 14 To 25
Set rngCol = sh.Range(sh.cells(7, i), sh.cells(sh.cells(Rows.count, i).End(xlUp).Row, i))
If rngCol.Find(ComboBox_Test.Value) Is Nothing Then
If sh.cells(iRow, i).Value = "" Then
sh.cells(iRow, i).Value = ComboBox_Test.Value: Exit For
End If
End If
Next
End Sub
You have this line of code:
CS = TPlaces(ComboBox_Tech_Essai.ListIndex) + 1: If CS < 14 Then CS = 14
Which is setting the column index you use near the end of your sub:
Feuil1.Cells(LS, CS) = ComboBox_Tech_Essai.Value
14 = N so with the statement If CS < 14 Then CS = 14 the code will never populate a column before N.
#FaneDuru
To do simple look at this picture:
I want to choose the test number from a combobox, and then add the test by chosing it from a combox like this :
when adding a new test the code should look for the test N° on column H and the the name of the chosen test from the combobox, if the test exsits in column N it should be adde in M, if we select the same test the code must add it on the column O ...
column
in the same column I must not have the same test Name, look at the 1st picture for test A in green. ( I have selcted 001 from the combobox so tets A was Added on column N, a second test A N°001 its Added in column M)
For test B in yellow you see that the first value is in column P, because I have selected tets N° OO1, for the 2nd test B I have choosen test Number 002 from the combobox so it was added on column N

Move row to different sheets based on value in 1 cell, but can't get it to take new row each time

I have been trying out something, by looking at other code ecample and stuff like that.
But I have some problems.
In my data input sheet, i have a dropdown menu with possible Names. But from what I have made now in the code, it just delete that. It does not copy the data over in other sheet and then just blank it out in data sheet, so every time I would have to make the dropdown list again.
Also when it move it over, it first move it to row 2, then to row 4. So jump over row 3, but then after that it just go to row 4 again and overwrite what is in row 4.
I think I need some kind of variables here for each sheet, but Im not strong in VBA, so not sure how to do it.
Here is the code that I have.
Sub CommandButton1_Click()
Dim TargetCounters(3) As Integer
Dim TargetNames(3) As String
TargetNames(0) = "Co"
TargetNames(1) = "Od"
TargetNames(2) = "Th"
TargetNames(3) = "Ca"
Dim i As Integer
Dim shSource As Worksheet
Dim shTargets(3) As Worksheet
Set shSource = ThisWorkbook.Sheets("Data input")
For i = 0 To 3
Set shTargets(i) = ThisWorkbook.Sheets(TargetNames(i))
If shTargets(i).Cells(2, 1).Value = "" Then
TargetCounters(i) = 2
Else
TargetCounters(i) = shTargets(i).Cells(2, 1).CurrentRegion.Rows.Count + 2
End If
Next i
i = 2
Dim MatchIndex As Integer
Do Until shSource.Cells(i, 1).Value = ""
Select Case shSource.Cells(i, 1).Value
Case "Co":
MatchIndex = 0
Case "Od":
MatchIndex = 1
Case "Th":
MatchIndex = 2
Case "Ca":
MatchIndex = 3
Case Else
MatchIndex = -1
End Select
If (MatchIndex = -1) Then
i = i + 1
Else
shSource.Rows(i).Copy
shTargets(MatchIndex).Cells(TargetCounters(MatchIndex), 1).PasteSpecial Paste:=xlPasteValues
shSource.Rows(i).Delete
TargetCounters(MatchIndex) = TargetCounters(MatchIndex) + 1
End If
Loop
End Sub
Here is a link to the excel I made. Right now I only made it to move to 4 sheets, but when working I will be able to add the rest.
https://www.dropbox.com/s/vvjt8z82xiuw9y1/Movedata.xlsm?dl=0
In short my problems is
It delete my dropdown list and it does not insert in a new free row everytime.
EDIT:
Have found out about the delete part now. Found there was function ClearContents instead of Delete.

How to set an automatically generated radio button to true in VBA?

I am creating an Excel sheet in which the radio buttons are automatically generated based on the value of specific parameter. Please refer this for clear understanding:
A group of radio buttons are copied n number of times. where n is the number of rows that refers to a parameter.
Each radio buttons in this auto-generated matrix should be checked against a condition and one of the twelve radio button should be set to True in one group that matches the condition. The main complication here is that, each group of radio buttons are copied to required rows based on the requirement and so, the radio buttons are generated n*12 times and i don't know how to program each radio button that is generated automatically.
I need to know, which Function can I use to fulfill my requirement.
I have created the matrix with the following code:
Dim n, m, i, j, x, k, a As Integer
n = (Sheets("ALLO").Range("E4").Value) * 2
x = Sheets("ALLO").Range("E3").Value
m = (Sheets("ALLO").Range("E5").Value) + 1
a = m
For i = 2 To n Step 2
Sheets("Dummy_Result").Range("A2:M2").Copy Destination:=Sheets("Results").Range("A" & i)
Next i
For j = 3 To n Step 2
Sheets("Dummy_Result").Range("A3:M3").Copy Destination:=Sheets("Results").Range("A" & j)
Next j
For k = n + 1 To m Step 1
Sheets("Dummy_Result").Range("A3:M3").Copy Destination:=Sheets("Results").Range("A" & k)
Next k
End Sub
My updated Program, for generating the buttons automatically for the range dependent on the value of 'm'. The number of buttons generated should be directly proportional to the value of 'm'. This Program doesn't work when I use the dynamic range instead of Fixed range (As suggested by Mr.JosephC)
Sub Test()
Dim n, m, i, j, x, k, a As Integer
n = (Sheets("ALLO").Range("E4").Value) * 2 'No of Tack stations
x = Sheets("ALLO").Range("E3").Value
m = (Sheets("ALLO").Range("E5").Value) + 1
a = m
For i = 2 To n Step 2 'Correct
Sheets("Dummy_Result").Range("A2").Copy Destination:=Sheets("Results_1").Range("A" & i)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next i
For j = 3 To n Step 2
Sheets("Dummy_Result").Range("A3").Copy Destination:=Sheets("Results_1").Range("A" & j)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next j
For k = n + 1 To m Step 1
Sheets("Dummy_Result").Range("A3").Copy Destination:=Sheets("Results_1").Range("A" & k)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next k
End Sub
Private Sub AddOptionButtons(ByRef TargetRange As Range)
Dim oCell As Range
For Each oCell In TargetRange
oCell.RowHeight = 20
oCell.ColumnWidth = 6
Dim oOptionButton As OLEObject
Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
oOptionButton.Name = "ob" & oCell.row & "_" & oCell.Column
'oOptionButton.Object.Caption = "Button" oOptionButton.Object.GroupName = "grp" & oCell.Top
Next
End Sub**strong text**
Please refer the Dummy result here
This is just something to get you started. Imagine you have 6 Form Controls Option buttons like this:
Then, if you pass them in an array buttons1 you may loop through them by their index and assign their value to True, based on another array with conditions condition1:
Public Sub TestMe()
Dim condition1 As Variant
condition1 = Array(False, True, False, False, False, False)
Dim buttons1 As Variant
buttons1 = Array("Option Button 2", "Option Button 3", "Option Button 4", _
"Option Button 5", "Option Button 6", "Option Button 7")
Dim cnt As Long
For cnt = LBound(buttons1) To UBound(buttons1)
With Worksheets(1).Shapes(buttons1(cnt)).OLEFormat
If condition1(cnt) Then .Object.Value = True
End With
Next cnt
End Sub
Thus, after running the code, as far as the second unit in the condition1 array is True, the Option Button 3 is selected.
This will add option buttons to each cell in the target range. It will resize the cells a bit to try and make enough space for them (you can fiddle with placement of the option buttons and size of the cells as you see fit). It will name the option buttons with their "index" values based on the row and column numbers they are set in ie. ob2_4 is option button in row 2, column 4 (D). It will also set the group name to be the same for all option buttons on the same row.
Sub Test()
Call AddOptionButtons(Sheet1.Range("B5:D7"))
End Sub
Private Sub AddOptionButtons(ByRef TargetRange As Range)
Dim oCell As Range
For Each oCell In TargetRange
oCell.RowHeight = 20
oCell.ColumnWidth = 6
Dim oOptionButton As OLEObject
Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
oOptionButton.Name = "ob" & oCell.Row & "_" & oCell.Column 'Name them to make it easier if you need to access them later
'oOptionButton.Object.Caption = "Caption" ' If you want to add text to the buttons
oOptionButton.Object.GroupName = "grp" & oCell.Top
Next
End Sub
Personal note:
As an aside, please use meaningful names for your variables. :) The only time you should use single character variables is if you have hardware requirements on the footprint of your code.

Select next item from combobox and click on a button Excel VBA

Have a combobox & command button placed on excel sheet. Combobox will have some items listed, say it have 1, 2, 3, 4, 5. When the combobox is loaded for the first time, by default first value ie 1 will be selected.
Now using a VBA macro, I want to select next value from the combobox list (ie 2) and click on the command button.
I googled this but unfortunately, not getting what I am expecting.
Here is what I have so far, but it dont do what I am expecting (Explained above): Getting an error message as Object doesn't support this property or method on line If Worksheets("QC Update").ComboBox1.SelectedIndex < ComboBox1.Items.Count - 1 Then
Sub Select_Next_Items()
If IsEmpty(Range("A9").Value) = True Then
If Worksheets("QC Update").ComboBox1.SelectedIndex < ComboBox1.Items.Count - 1 Then
ComboBox1.ListIndex = 0 ' select first Item in listbox
ComboBox1.ListIndex = ComboBox1.ListCount - 1 ' selects last item
Set ComboBox1.SelectedIndex = Worksheets("QC Update").ComboBox1.SelectedIndex + 1
Set ComboBox1.ListCount = 0
End If
End If
End Sub
hope you guys don't feel offended here, as I have a more clearer and a more straight forward answer.
ComboBox1.ListIndex = ComboBox1.ListIndex +1
Here is a more complete ones. We have to take into account when it is at the end of the list therefore
If ComboBox1.ListIndex = ComboBox1.ListCount -1 Then
ComboBox1.ListIndex =1
Else
ComboBox1.ListIndex = ComboBox1.ListIndex +1
I hope my reply is helpful to most of you especially those who are new to Vba and need to use it urgently.
This is simple to understand if you have solid background on programming in C++ / java
I wonder if this is your intention.
Sub Select_Next_Item()
' 07 Apr 2017
Dim Ws As Worksheet
Dim Cbx As OLEObject
Dim Ix As Integer
Set Ws = Worksheets("QC Update")
If IsEmpty(Ws.Range("A9").Value) = True Then
Set Cbx = Ws.OLEObjects("ComboBox1")
With Cbx.Object
Ix = .ListIndex + 1
If Ix = .ListCount Then Ix = 0
If .ListCount Then .ListIndex = Ix
End With
End If
End Sub
If the cell A9 is found empty, the code will look at the "ComboBox1" (and will crash if it isn't found on the same, specified worksheet). It will change the selection in that combobox to the next value in the list. But if it was already at the last list item it will select the first, and if there are no list items in the combobox it will do nothing.
Finally this issues is resolved with below code,
Set Cbx = Worksheets("QC Update").OLEObjects("ComboBox1")
With Cbx.Object
Ix = .ListIndex + 1
If Ix = .ListCount Then Ix = 0
If .ListCount Then .ListIndex = Ix
End With
I share my simple solution
Try
ComboBoxDireccion.SelectedIndex = ComboBoxDireccion.SelectedIndex + 1
Catch ex As Exception
ComboBoxDireccion.SelectedIndex = 0
End Try

Resources