In a userform that I create, I add a scrollable listbox (2 columns, 7 rows) and a button.
When I click the button, the value in the third column should change, and the listbox should display the new value accordingly.
Currently particular rows fail to display the new value even I change it already. I also notice that the rows that fail to display the new value are those not showing in the scrollable list box when I click the button.
When I click the button once, the second column of each row is - as expected - increased by 1:
However, when I click the button a second time, the rows that are not displayed in the scrollable listbox at the moment, fail to increase by 1 again:
This is the code I have so far:
Private Sub CommandButton1_Click()
For i = 0 To lstProducts.ListCount - 1
lstProducts.List(i, 1) = lstProducts.List(i, 1) + 1
Next i
End Sub
Private Sub UserForm_Initialize()
Dim iCell As Long
VBA.Randomize
With lstProducts
.ColumnCount = 2
.ColumnWidths = "120;60;50"
.List = Worksheets("Product").Range("a1").CurrentRegion.Value
End With
End Sub
Replace your loop with this code
x = lstProducts.TopIndex
For i = 0 To lstProducts.ListCount - 1
lstProducts.ListIndex = i
lstProducts.List(i, 1) = lstProducts.List(i, 1) + 1
Next i
lstProducts.ListIndex = x
First post on this forum - I have a fillable form which I would like to do the following.
There are two check boxes, (Legacy form item), labelled H and N, depending on which one is selected the value of another input box (Legacy form item) should be equal to or greater than a value. E.G if N is selected, the input cell should be greater than 0.5 if H is selected the cell should be equal to or greater than 0.5.
Can anyone impart any wisdom on this one, I would then set it to run a check once the user has input the value, based on the checkbox option and value input into the cell.
Thanks in advance,
Daniel
You have 3 objects and you need to react on any change. So I'd put something like this into the code section of the form:
Private Sub cbN_Click() ' name of checkbox N is cbN
proc_chg
End Sub
Private Sub cbH_Click()
proc_chg
End Sub
Private Sub tbx_Change() ' name of textbox is tbx
proc_chg
End Sub
Private Sub proc_chg
Dim rVal as Single
rVal = Val(Me.tbx.value)
If cbN And rVal > 0.5 Then
tbx.BackColor = vbGreen ' OK
ElseIf cbH And rVal >= 0.5 Then
tbx.BackColor = vbGreen ' OK
Else
tbx.BackColor = vbRed ' wrong
End If
End Sub
This will capture every change on the form and set the background color of the inputbox accordingly. (Please complete the logic in proc_chg, this is just an example.)
I want to set up a public function like the following:
(A)
Public Function CheckYNField(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkControl = -1
ElseIf chkField = "N" Then
chkControl = 0
Else: chkControl = 0
End If
End Function
(B)
Public Function CheckYNFlipper(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkField = "N"
chkControl = 0
ElseIf chkField = "N" Then
chkField = "Y"
chkControl = -1
Else: chkField = "Y"
chkControl = -1
End If
End Function
The reason for this is, that I have a form, which has an underlying SQL table. I have no control over the data, but I must represent it, for the ability to maintain it. I have 10 fields, in the underlying table, which have a Y or N as their values. The data types are actually nvarchar(10). At the same time, I have to show these fields as checkbox controls, on the form, for ease of use.
The above code, is an attempt I am making to A - set the checkbox control to align with the current value in the table--> -1 = Y and 0 = N, and to B - update the table value, and switch the check box to checked or unchecked, from what it was, to the opposite, based on the onclick event of that control.
I want to make chkField and chkControl variables to the public function, that would be the table-field, and the form-control. I can't seem to get the right syntax, and was hoping someone might have clarification on how to do this.
for the form load and current, I tried this:
CheckYNField Forms("frmFormNameA").Controls(chkCheckNameA), tblTableName.FieldA
for the on click, I tried this:
CheckYNFlipper Forms("frmFormNameA").Controls(chkCheckNameA), tblTableName.FieldA
I've tried some other methods, but doesn't seem to be working. I'm doing something wrong, but I can't tell what. Appreciate any tips!
Edit/Update:
I tried Kostas K.'s solution, abandoning the idea of making a public functions with parameters for the fields and controls. I put the following, on load and on current:
With Me
If .txtfieldboundtablefieldA.Value = "Y" Then
.unboundchkA.Value = True
ElseIf .txtfieldboundtablefieldA.Value = "N" Then
.unboundchkA.Value = False
Else: .unboundchkA.Value = False
End If
End With
This is on a continuous form, so that it can show like a giant grid. There are the identifying bound field controls, and then a series of these checkboxes, to display the Y/N true/false status of each of these particular fields. I can't bound the checkboxes to the fields, because it changes the field value in the table to -1 or 0, and we need it to stay Y or N. I added a bound text field, to hold the table/field value for each row (hence the call to a text box control in the above revised code). The checkbox is unbound, and is there to display the field value, and allow the user to check and uncheck, so I can use on-click code to change the table field value between Y and N.
The above code is not seeming to show the correct checkbox value for each bound text field, based on each row. It shows based on the row that currently has focus. If I click on a row, where the table field is Y, all rows checkboxes on the form show true. If I move to a row, where the table field is N, all checkboxes for all rows change to false. I am struggling to just initially get 1 checkbox to show accurately, on every row of the continuous form, based on every record in the table. This is a small table, like 30 records. I really didn't think it would be so difficult to present this the way we need to.
Any ideas, how I could better do this?
Edit:
Set the Control Source of the checkbox to:
= IIf([YourYesNoField] = "Y", -1, 0)
In order to update when clicked:
Private Sub chkCheckNameA_Click()
Dim yesNo As String
yesNo = IIf(Me.chkCheckNameA.Value = 0, "Y", "N") 'reverse value
CurrentDb.Execute "Update [YourTable] SET [YourYesNoField]='" & yesNo & "' WHERE [ID]=" & Me![ID], dbFailOnError
Me.Requery
End Sub
You could try something this.
Check the Y/N field and assign the function's boolean return value to the checkbox (A).
On the checkbox click event, check its value and update the Y/N field (B).
'Form Load
Private Sub Form_Load()
With Me
.chkCheckNameA.Value = CheckYNField(![FieldA])
End With
End Sub
'Click
Private Sub chkCheckNameA_Click()
With Me
![FieldA] = IIf(.chkCheckNameA.Value = 0, "N", "Y")
End With
End Sub
'True returns -1, False returns 0
Private Function CheckYNField(ByVal chkField As String) As Boolean
CheckYNField = (chkField = "Y")
End Function
chkControl is a Control, so you need to access a property of that control. Try changing your code to:
Public Function CheckYNField(chkControl As Control, chkField As String)
If chkField = "Y" Then
chkControl.Value = -1
ElseIf chkField = "N" Then
chkControl.Value = 0
Else: chkControl.Value = 0
End If
End Function
and then the same idea in your other function.
I'm having a really hard time writing a code for this.
We hence four cells with variable values, a picture should appear depending on the cell with the highest value when a button is clicked.
Example: If cell A1's value is higher than the other cells, picture A should show up when a button is clicked, if cell B1's value is higher, then picture B, which is assigned to that cell, should appear.
We tried our best but couldn't find a solution, any help would be appreciated
Well, this is something trivial, but here is how I would do it:
Public Sub ShowPic()
Me.s1.Visible = b_is_visible(Me.s1.Name)
Me.s2.Visible = b_is_visible(Me.s2.Name)
End sub
Public Function b_is_visible(str_name As String) As Boolean
If str_name = cells(1,1) Then
b_is_visible = True
end if
End Function
In cell A1 you should put the name of the image. Thus, based on it, the image would be either visible or not. The Images should be in a form. The code above is in the form.
There are plenty of solutions. One of them is to have some folder with pictures you wanna display, and name them as rows with max value. E.g. if max value is in row 3, the picture3.jpg file would be displayed.
Sub test123()
Dim Rng As Range
Dim maxRow As Integer, maxVal As Integer
Set Rng = Range("A1:A4")
maxVal = Application.WorksheetFunction.Max(Rng)
picNum = Application.Match(maxVal, Rng, 0)
ActiveSheet.Pictures.Delete
ActiveSheet.Pictures.Insert("K:\user files\user 1\pictures\picture" & picNum & ".jpg").Select
End Sub
EDIT:
If you like to reposition image, you can do it by renaming it and using some commends.
Selection.ShapeRange.Name = "Pic1"
ActiveSheet.Shapes("Pic1").Left = ActiveSheet.Cells(2, 2).Left
ActiveSheet.Shapes("Pic1").Top = ActiveSheet.Cells(2, 2).Top
ActiveSheet.Shapes("Pic1").Height = ActiveSheet.Range("G1:G7").Height
ActiveSheet.Shapes("Pic1").Width = ActiveSheet.Range("B1:G1").Width
Is it possible to set up the headers in a multicolumn listbox without using a worksheet range as the source?
The following uses an array of variants which is assigned to the list property of the listbox, the headers appear blank.
Sub testMultiColumnLb()
ReDim arr(1 To 3, 1 To 2)
arr(1, 1) = "1"
arr(1, 2) = "One"
arr(2, 1) = "2"
arr(2, 2) = "Two"
arr(3, 1) = "3"
arr(3, 2) = "Three"
With ufTestUserForm.lbTest
.Clear
.ColumnCount = 2
.List = arr
End With
ufTestUserForm.Show 1
End Sub
Here is my approach to solve the problem:
This solution requires you to add a second ListBox element and place it above the first one.
Like this:
Then you call the function CreateListBoxHeader to make the alignment correct and add header items.
Result:
Code:
Public Sub CreateListBoxHeader(body As MSForms.ListBox, header As MSForms.ListBox, arrHeaders)
' make column count match
header.ColumnCount = body.ColumnCount
header.ColumnWidths = body.ColumnWidths
' add header elements
header.Clear
header.AddItem
Dim i As Integer
For i = 0 To UBound(arrHeaders)
header.List(0, i) = arrHeaders(i)
Next i
' make it pretty
body.ZOrder (1)
header.ZOrder (0)
header.SpecialEffect = fmSpecialEffectFlat
header.BackColor = RGB(200, 200, 200)
header.Height = 10
' align header to body (should be done last!)
header.Width = body.Width
header.Left = body.Left
header.Top = body.Top - (header.Height - 1)
End Sub
Usage:
Private Sub UserForm_Activate()
Call CreateListBoxHeader(Me.listBox_Body, Me.listBox_Header, Array("Header 1", "Header 2"))
End Sub
No. I create labels above the listbox to serve as headers. You might think that it's a royal pain to change labels every time your lisbox changes. You'd be right - it is a pain. It's a pain to set up the first time, much less changes. But I haven't found a better way.
I was looking at this problem just now and found this solution. If your RowSource points to a range of cells, the column headings in a multi-column listbox are taken from the cells immediately above the RowSource.
Using the example pictured here, inside the listbox, the words Symbol and Name appear as title headings. When I changed the word Name in cell AB1, then opened the form in the VBE again, the column headings changed.
The example came from a workbook in VBA For Modelers by S. Christian Albright, and I was trying to figure out how he got the column headings in his listbox :)
Simple answer: no.
What I've done in the past is load the headings into row 0 then set the ListIndex to 0 when displaying the form. This then highlights the "headings" in blue, giving the appearance of a header. The form action buttons are ignored if the ListIndex remains at zero, so these values can never be selected.
Of course, as soon as another list item is selected, the heading loses focus, but by this time their job is done.
Doing things this way also allows you to have headings that scroll horizontally, which is difficult/impossible to do with separate labels that float above the listbox. The flipside is that the headings do not remain visible if the listbox needs to scroll vertically.
Basically, it's a compromise that works in the situations I've been in.
There is very easy solution to show headers at the top of multi columns list box.
Just change the property value to "true" for "columnheads" which is false by default.
After that Just mention the data range in property "rowsource" excluding header from the data range and header should be at first top row of data range then it will pick the header automatically and you header will be freezed.
if suppose you have data in range "A1:H100" and header at "A1:H1" which is the first row then your data range should be "A2:H100" which needs to mention in property "rowsource" and "columnheads" perperty value should be true
Regards,
Asif Hameed
Just use two Listboxes, one for header and other for data
for headers - set RowSource property to top row e.g. Incidents!Q4:S4
for data - set Row Source Property to Incidents!Q5:S10
SpecialEffects to "3-frmSpecialEffectsEtched"
I like to use the following approach for headers on a ComboBox where the CboBx is not loaded from a worksheet (data from sql for example). The reason I specify not from a worksheet is that I think the only way to get RowSource to work is if you load from a worksheet.
This works for me:
Create your ComboBox and create a ListBox with an identical layout but just one row.
Place the ListBox directly on top of the ComboBox.
In your VBA, load ListBox row1 with the desired headers.
In your VBA for the action yourListBoxName_Click, enter the following code:
yourComboBoxName.Activate`
yourComboBoxName.DropDown`
When you click on the listbox, the combobox will drop down and function normally while the headings (in the listbox) remain above the list.
I was searching for quite a while for a solution to add a header without using a separate sheet and copy everything into the userform.
My solution is to use the first row as header and run it through an if condition and add additional items underneath.
Like that:
If lborowcount = 0 Then
With lboorder
.ColumnCount = 5
.AddItem
.Column(0, lborowcount) = "Item"
.Column(1, lborowcount) = "Description"
.Column(2, lborowcount) = "Ordered"
.Column(3, lborowcount) = "Rate"
.Column(4, lborowcount) = "Amount"
End With
lborowcount = lborowcount + 1
End If
With lboorder
.ColumnCount = 5
.AddItem
.Column(0, lborowcount) = itemselected
.Column(1, lborowcount) = descriptionselected
.Column(2, lborowcount) = orderedselected
.Column(3, lborowcount) = rateselected
.Column(4, lborowcount) = amountselected
End With
lborowcount = lborowcount + 1
in that example lboorder is the listbox, lborowcount counts at which row to add the next listbox item. It's a 5 column listbox. Not ideal but it works and when you have to scroll horizontally the "header" stays above the row.
Here's my solution.
I noticed that when I specify the listbox's rowsource via the properties window in the VBE, the headers pop up no problem. Its only when we try define the rowsource through VBA code that the headers get lost.
So I first went a defined the listboxes rowsource as a named range in the VBE for via the properties window, then I can reset the rowsource in VBA code after that. The headers still show up every time.
I am using this in combination with an advanced filter macro from a listobject, which then creates another (filtered) listobject on which the rowsource is based.
This worked for me
Another variant on Lunatik's response is to use a local boolean and the change event so that the row can be highlighted upon initializing, but deselected and blocked after a selection change is made by the user:
Private Sub lbx_Change()
If Not bHighlight Then
If Me.lbx.Selected(0) Then Me.lbx.Selected(0) = False
End If
bHighlight = False
End Sub
When the listbox is initialized you then set bHighlight and lbx.Selected(0) = True, which will allow the header-row to initialize selected; afterwards, the first change will deselect and prevent the row from being selected again...
Here's one approach which automates creating labels above each column of a listbox (on a worksheet).
It will work (though not super-pretty!) as long as there's no horizontal scrollbar on your listbox.
Sub Tester()
Dim i As Long
With Me.lbTest
.Clear
.ColumnCount = 5
'must do this next step!
.ColumnWidths = "70;60;100;60;60"
.ListStyle = fmListStylePlain
Debug.Print .ColumnWidths
For i = 0 To 10
.AddItem
.List(i, 0) = "blah" & i
.List(i, 1) = "blah"
.List(i, 2) = "blah"
.List(i, 3) = "blah"
.List(i, 4) = "blah"
Next i
End With
LabelHeaders Me.lbTest, Array("Header1", "Header2", _
"Header3", "Header4", "Header5")
End Sub
Sub LabelHeaders(lb, arrHeaders)
Const LBL_HT As Long = 15
Dim T, L, shp As Shape, cw As String, arr
Dim i As Long, w
'delete any previous headers for this listbox
For i = lb.Parent.Shapes.Count To 1 Step -1
If lb.Parent.Shapes(i).Name Like lb.Name & "_*" Then
lb.Parent.Shapes(i).Delete
End If
Next i
'get an array of column widths
cw = lb.ColumnWidths
If Len(cw) = 0 Then Exit Sub
cw = Replace(cw, " pt", "")
arr = Split(cw, ";")
'start points for labels
T = lb.Top - LBL_HT
L = lb.Left
For i = LBound(arr) To UBound(arr)
w = CLng(arr(i))
If i = UBound(arr) And (L + w) < lb.Width Then w = lb.Width - L
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
L, T, w, LBL_HT)
With shp
.Name = lb.Name & "_" & i
'do some formatting
.Line.ForeColor.RGB = vbBlack
.Line.Weight = 1
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.TextFrame2.TextRange.Characters.Text = arrHeaders(i)
.TextFrame2.TextRange.Font.Size = 9
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
End With
L = L + w
Next i
End Sub
You can give this a try. I am quite new to the forum but wanted to offer something that worked for me since I've gotten so much help from this site in the past. This is essentially a variation of the above, but I found it simpler.
Just paste this into the Userform_Initialize section of your userform code. Note you must already have a listbox on the userform or have it created dynamically above this code. Also please note the Array is a list of headings (below as "Header1", "Header2" etc. Replace these with your own headings. This code will then set up a heading bar at the top based on the column widths of the list box. Sorry it doesn't scroll - it's fixed labels.
More senior coders - please feel free to comment or improve this.
Dim Mywidths As String
Dim Arrwidths, Arrheaders As Variant
Dim ColCounter, Labelleft As Long
Dim theLabel As Object
[Other code here that you would already have in the Userform_Initialize section]
Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)
With theLabel
.Left = ListBox1.Left
.Top = ListBox1.Top - 10
.Width = ListBox1.Width - 1
.Height = 10
.BackColor = RGB(200, 200, 200)
End With
Arrheaders = Array("Header1", "Header2", "Header3", "Header4")
Mywidths = Me.ListBox1.ColumnWidths
Mywidths = Replace(Mywidths, " pt", "")
Arrwidths = Split(Mywidths, ";")
Labelleft = ListBox1.Left + 18
For ColCounter = LBound(Arrwidths) To UBound(Arrwidths)
If Arrwidths(ColCounter) > 0 Then
Header = Header + 1
Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)
With theLabel
.Caption = Arrheaders(Header - 1)
.Left = Labelleft
.Width = Arrwidths(ColCounter)
.Height = 10
.Top = ListBox1.Top - 10
.BackColor = RGB(200, 200, 200)
.Font.Bold = True
End With
Labelleft = Labelleft + Arrwidths(ColCounter)
End If
Next
This is a bummer. Have to use an intermediate sheet to put the data in so Excel knows to grab the headers. But I wanted that workbook to be hidden so here's how I had to do the rowsource.
Most of this code is just setting things up...
Sub listHeaderTest()
Dim ws As Worksheet
Dim testarr() As String
Dim numberOfRows As Long
Dim x As Long, n As Long
'example sheet
Set ws = ThisWorkbook.Sheets(1)
'example headers
For x = 1 To UserForm1.ListBox1.ColumnCount
ws.Cells(1, x) = "header" & x
Next x
'example array dimensions
numberOfRows = 15
ReDim testarr(numberOfRows, UserForm1.ListBox1.ColumnCount - 1)
'example values for the array/listbox
For n = 0 To UBound(testarr)
For x = 0 To UBound(testarr, 2)
testarr(n, x) = "test" & n & x
Next x
Next n
'put array data into the worksheet
ws.Range("A2").Resize(UBound(testarr), UBound(testarr, 2) + 1) = testarr
'provide rowsource
UserForm1.ListBox1.RowSource = "'[" & ws.Parent.Name & "]" & ws.Name & "'!" _
& ws.Range("A2").Resize(ws.UsedRange.Rows.Count - 1, ws.UsedRange.Columns.Count).Address
UserForm1.Show
End Sub
For scrolling, one idea is to create a simulated scroll bar which would shift the entire listbox left and right.
ensure the list box is set to full width so the horizontal scroll
bar doesn't appear (wider than the space available, or we wouldn't
need to scroll)
add a scroll bar control at the bottom but with .left and .width to
match the available horizontal space (so not as wide as the too-wide listbox)
calculate the distance you need to scroll as the difference between
the width of the extended list box and the width of the available
horizontal space
set .Min to 0 and .Max to the amount you need to scroll
set .LargeChange to make the slider-bar wider (I could only get it
to be half of the total span)
For this to work, you'd need to be able to cover left and right of the intended viewing space with a frame so that the listbox can pass underneath it and preserve any horizontal framing in the form. This turn out to be challenging, as getting a frame to cover a listbox seems not to work easily. I gave up at that point but am sharing these steps for posterity.
I found a way that seems to work but it can get messy the more complicated your code gets if you're dynamically clearing the range after every search or changing range.
Spreadsheet:
A B C
1 LName Fname
2 Smith Bob
set rng_Name = ws_Name.range("A1", ws_Name.range("C2").value
lstbx.Main.rowsource = rng_Name.Address
This will loads the Headers into the listbox and allow you to scroll.
Most importantly, if you're looping through your data and your range comes up empty, then your listbox won't load the headers correctly, so you will have to account for no "matches".
Why not just add Labels to the top of the Listbox and if changes are needed, the only thing you need to programmatically change are the labels.