I’m using a userform with 12 listboxes (numbered 2-13). Each list box could contain 0-8 items assigned by user from main listbox1. I run the following code to output the content of each list box (12 boxes) to sheet “Tray” when a button is pressed.
Each listbox is then output into corresponding columns of each tray from columns B-M. Listbox2 fills column 1 of each tray and so on. A maximum of 4 trays can be filled. The code checks the 1st well of each tray and if it contains a value it assumes the tray is full & begins filling the next tray.
Problem: If the first tray contains a blank column(listbox) and the second tray contains values in the same listbox, the code will fill blank column of the frist tray with values that should be in the second tray. Please see pictures below and updated code below:
Listboxes 2,3 and 4 for Tray 1 (note listbox3 is empty)
Listboxes 2,3 and 4 for tray 2 (note listbox3 has data)
Code ran two times: Listbox3 from tray2 appears in tray1 (erroneously!!!)
Expected output:
Sub Worklist()
'
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Dim item As ListBox
Const cstrNames As String = "Listbox2,Listbox3,Listbox4,Listbox5,Listbox6,Listbox7,Listbox8,Listbox9,Listbox10,Listbox11,Listbox12,Listbox13"
Application.ScreenUpdating = False
lngColNum = 2
For Each VarName In Split(cstrNames, ",")
If UserForm2.Controls(VarName).ListIndex <> -1 Then 'if listbox is not blank
If Sheets("Tray").Cells(4, lngColNum).Value = 0 Then
'checks if value in row 3 column "lngColNum" is empty
lngRowNum = 4
ThisWorkbook.Sheets("Tray").Range("C2").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(15, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 15
ThisWorkbook.Sheets("Tray").Range("C13").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(26, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 26
ThisWorkbook.Sheets("Tray").Range("C24").Value = UserForm2.TextBox1.Value
Else 'otherwise assumes tray starts in row 5, column "lngColNum"
lngRowNum = 37
ThisWorkbook.Sheets("Tray").Range("C35").Value = UserForm2.TextBox1.Value
End If
For i = 0 To UserForm2.Controls(VarName).ListCount - 1
Var = UserForm2.Controls(VarName).List(i)
DblDashPos = InStr(1, Var, "--")
FirstPeriodPos = InStr(1, Var, ".")
Sheets("Tray").Select
ActiveSheet.Cells(lngRowNum, lngColNum) = Left(Var, DblDashPos - 1) & Right(Var, Len(Var) - FirstPeriodPos + 1)
lngRowNum = lngRowNum + 1
Next i
End If
lngColNum = lngColNum + 1
Next
Application.ScreenUpdating = True
End Sub
Thank you very much!
The problem is that you're only testing the column that corresponds to the ListBox to see if the cell is empty. If you want to test that all of the columns in a "tray" are empty, you need to test once for the entire sheet. Something like this (untested because I'm too lazy to rebuild your form):
Private Function FindFirstUnusedRow(sheet As Worksheet) As Long
Dim testColumn As Long, testRow As Long
Dim used As Boolean
For testRow = 4 To 37 Step 11
used = False
For testColumn = 2 To 13
If IsEmpty(sheet.Cells(testRow, testColumn)) = False Then
used = True
Exit For
End If
Next testColumn
If used = False Then
FindFirstUnusedRow = testRow
Exit For
End If
Next testRow
End Function
Then in your code, call it before your loop:
Sub Worklist()
Dim var As Variant
Dim i As Long, dashPos As Long, periodPos As Long, colNum As Long
Dim rowNum As Long, Dim sheet As Worksheet
Application.ScreenUpdating = False
Set sheet = ThisWorkbook.Sheets("Tray")
rowNum = FindFirstUnusedRow(sheet)
If rowNum = 0 Then
Debug.Print "All trays full."
Exit Sub
End If
Dim current As ListBox
For colNum = 2 To 13
Set current = UserForm2.Controls("Listbox" & colNum)
If current.ListIndex <> -1 Then 'if listbox is not blank
sheet.Cells(rowNum - 2, colNum).Value = UserForm2.TextBox1.Value
For i = 0 To current.ListCount - 1
var = current.List(i)
dashPos = InStr(1, var, "--")
periodPos = InStr(1, var, ".")
sheet.Cells(rowNum + i, colNum) = Left$(var, dashPos - 1) & _
Right$(var, Len(var) - periodPos + 1)
Next i
End If
Next colNum
Application.ScreenUpdating = True
End Sub
A couple other notes: You can ditch the Sheets("Tray").Select line entirely - you never use the selection object. Same thing with the mixed references to ActiveSheet and ThisWorkbook.Sheets("Tray"). Grab a reference and use it.
Also, these lines don't do what you think they do:
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Of all the variables you declare, everything is a Variant except lngRowNum. If you want to combine declarations on one line like that, you still need to specify a type for each variable, or they'll default to Variant. See the example code above.
Related
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.
I have the following userform:
Using the code below I can save the names of each selected checkbox into a sheet. The value will be saved in the same column, but on different rows (of course), as more than 1 checkbox can be selected.
Dim indProdWs As Worksheet
Dim ctl As Control
Dim i As Long
Set indProdWs = tWb.Worksheets("INDICATION-PRODUCT")
i = 4
' This is the row where i want to save the first value
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = ctl.Caption: i = i + 1
End If
End If
Next ctl
However, as you can see in the first image, for each row of products there's a label.
This is what I want to accomplish:
If Product 22 in the second row is selected, then I want the name to be saved on the cell with the following format:
Label2 - Product22
Or if Product 51 in the second row is selected:
Label 5 - Product 51
As you can see, the label number always matches the first digit of the product. I tried using that as a variable, but I haven't been successful.
Thank you for any help you can give me!
is the name actually "Product22" or this just an example? – Siddharth Rout 6 mins ago
#SiddharthRout just an example, but the format is similar. An actual name is seg_cb_selInd_22 (for example). – soraia635 1 min ago
Is this what you are trying?
Change the For - Next code to the below
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = Controls("seg_l_selInd_" & _
GetNumber(ctl.Name)).Caption & _
" - " & _
ctl.Name
i = i + 1
End If
End If
Next ctl
and then add this function to your code
Private Function GetNumber(s As String)
Dim numb As Long
Dim i As Long
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case 0 To 9
numb = Mid(s, i, 1)
Exit For
End Select
Next
GetNumber = numb
End Function
Note: This function assumes that you will pass an Alphanumeric string to it.
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
I wrote a function that supposed to get a specific part of a specific Column, and then, by comparing each entry of the column to the value of the cell that is left to it, count the times a specific condition is met.
It all works alright, except one problem.. if I use the function on "Sheet1", get a result and then switch to "Sheet2" and use the function on this sheet it changes the result on "Sheet1" for some reason.
Function countStable(rangeObj As Range) 'rangeObj that being passed is a namedRange(Synamic Range)
Application.Volatile
ActiveSheet.Select
Dim entry, preEntryVal, entryVal As Variant
Dim counters(1 To 5, 1 To 1) As Integer
Dim cStable, cIncreased, cDecreased, cAdded, cLost
cStable = 0
cIncreased = 0
cDecreased = 0
cAdded = 0
cLost = 0
Set rangeObj = Intersect(rangeObj, rangeObj.Parent.UsedRange)
For Each entry In rangeObj
If Not IsEmpty(entry.Value) And Not IsEmpty(ActiveSheet.Range("A" & entry.Row)) Then
entryVal = entry.Value
preEntryVal = ActiveSheet.Cells(entry.Row, entry.Column - 1).Value
If entryVal = preEntryVal Then
cStable = cStable + 1
ElseIf InStr(entryVal, "-") And Not (InStr(preEntryVal, "-")) Then
cLost = cLost + 1
ElseIf Not InStr(entryVal, "-") And InStr(preEntryVal, "-") Then
cAdded = cAdded + 1
ElseIf preEntryVal < entryVal Then
cDecreased = cDecreased + 1
ElseIf preEntryVal > entryVal Then
cIncreased = cIncreased + 1
End If
End If
counters(1, 1) = cStable
counters(2, 1) = cIncreased
counters(3, 1) = cDecreased
counters(4, 1) = cAdded
counters(5, 1) = cLost
Next
countStable = counters
End Function
As commented inside the code, rangeObj that is being passed as parameter was defined in the name manager and it is based on an Offset formula.
I know it changes the values on both sheets because of the dynamic range, but not sure why.. I don't want it to be changed.
Help please?
In several places, the code references the ActiveSheet. Wherever the function appears, it will reflect the value of whatever sheet is active. You'll want to use the parent of the supplied range object instead.
Dim currentSheet as Worksheet
Set currentSheet = rangeObj.Parent
Then, search and replace ActiveSheet with currentSheet in the method.
I am a novice of Vba.
I have been litteraly fighting all day with this bit of code:
Sub ComandsCompactVisualization()
Dim x, i As Integer
Dim CellToAnalyse As Range
x = 2
i = 0
For i = 0 To 5 Step 1
Set CellToAnalyse = Worksheets("Comandi").Cells(x + i, 2)
If Not CellToAnalyse.Font.ColorIndex = 2 Then
Worksheets("Comandi").Rows("x+i:2").Hidden = True
End If
Next i
End Sub
I am trying to hide all the rows that in cell (x+i,2) have not got red text.
I am almost there but... Rows does not seem to accept as content Rows("x+i:2").
I obtain Runtime error 13 "Type mismatch".
If I substitute its content with Rows("2:2") row 2 is deleted but I am not any more able to hide all the other rows that do not have red text in column 2.
Ideas?
Anything between quotes "like this" is just a string. To perform arithmetic on x you need to do this first, then concatenate it to the other part of the string. Like this:
.Rows((x + i) & ":2")
BTW Isn't red 3..?
Sub ComandsCompactVisualization()
Dim x as long, i As Long 'You must declare ALL variables (x was as variant in your code)
Dim CellToAnalyse As Range
dim WS as Worksheet
'x = 2 'if x is always the same value, no need to calculate it each loop
'i = 0 'numbers are initialized to be 0, strings to be "", boolean to be false.
set WS=Sheets("Commandi")
For i = 0 To 5 ' Step 1
Set CellToAnalyse = WS.Cells(2 + i, 2)
If CellToAnalyse.Font.ColorIndex <> 2 Then
CellToAnalyse.entirerow.hidden=true
' WS.Rows(2+i).entirerow.hidden = true is the same result
End If
Next i
End Sub