I wrote this code to place information from a sheet into a list box in my user form. This is the code I wrote but it is telling me something is out of range although I can't figure out what is out of range.
Private Sub PopulateSearchBox()
Dim wsTL2 As Worksheet
Set wsTL2 = Worksheets("Task List2")
Dim last_row As Long
last_row = wsTL2.Cells(wsTL2.Rows.Count, "C").End(xlUp).Row 'the last populated row in C so it covers the whole range of data that I need.
With Me.searchBox
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = "100,100,100"
.RowSource = "Task List2!A1:C" & last_row
End With
End Sub
the RowSource property of ComboBox expects an address string.
so you could do:
RowSource = wsTL2.Name & "!" & rng.Address
With Me.searchBox
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = "100,100,100"
.RowSource = RowSource
End With
Though it is likely you would be more after the .List property?
Set rng = wsTL2.Cells(wsTL2.Rows.Count, "C").End(xlUp)
With Me.searchBox
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = "100,100,100"
'.RowSource = RowSource
.List = rng.Value2
End With
Related
here I have serial number in textbox (txt_Rec) from worksheet("Sale") lastrow.
Now i want to get conditional values (Serial Number) in textbox (txt_Rec), if i select "Sale" from combobox(Me.cmb_Type)dropdown list then i want worksheet("Sale") lastrow serial number in textbox (txt_Rec) and if i select "Purchase" from combobox(cmb_Type)dropdown list then i want worksheet("Purchase") lastrow serial number in textbox (txt_Rec).
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sale")
Dim lastrow As Long
lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
Me.txt_Rec.Value = lastrow
``` dropdown for Item type ```
With Me.cmb_Type
.Clear
.AddItem ""
.AddItem "Sale"
.AddItem "Purchase"
End With
End Sub
Please, copy the next event code in the form code module:
Private Sub cmb_Type_Change()
Dim sh As Worksheet
If cmb_Type.Value <> "" Then
Set sh = ThisWorkbook.Sheets(cmb_Type.Value)
Me.txt_Rec.Text = sh.Range("A" & sh.rows.count).End(xlUp).row
Else
Me.txt_Rec.Text = ""
End If
End Sub
And comment the next code lines from the shown Initialize event:
'Dim lastrow As Long
'lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
'Me.txt_Rec.Value = lastrow
If you want the combo to initially show "Sale", you should add
.ListIndex = 1
after .AddItem "Purchase" and before End With...
I have some records being displayed in a listbox. I have a 'Hide' button in my userform which when clicked hides the row selected and the row remains in the excel sheet. But if I open the userform again then the data loaded has all the hidden rows. I have created a column 'Active' and assigned it true values. I want to change this value to false when the user selects a row and clicks on hide. I want all the data in the excel sheet to remain and only rows with 'Active' value True will be displayed in the listbox. How do I achieve this?
Here is my code -
Sub Employee_Listbox()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("EMPMaster")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox2
.ColumnCount = 6
.ColumnWidths = "150,70,100,50,70,0"
.List = sh.Range("A2:F" & last_row).Value '.RowSource = sh.Name & "!A2:F" & last_row
End With
End Sub
Private Sub CommandButton15_Click() '''Hide button
If Me.ListBox2.ListIndex >= 0 Then
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex
End If
End Sub
Try this out. It uses Match to locate the row on the source worksheet and flag that employee as "Inactive".
Option Explicit
Const MASTER_SHEET As String = "EMPMaster"
Const VAL_ACTIVE = "Active"
Const VAL_INACTIVE = "Inactive"
Private Sub UserForm_Activate()
LoadEmployeeList
End Sub
Sub LoadEmployeeList()
Dim sh As Worksheet, rw As Range, i As Long
Set sh = MasterSheet
With Me.ListBox2
.Clear
.ColumnCount = 6
.ColumnWidths = "150,70,100,50,70,0"
End With
For Each rw In sh.Range("A2:F" & sh.Cells(Rows.Count, "A").End(xlUp).Row).Rows
If rw.Columns("G").Value = VAL_ACTIVE Then 'only load "Active" employees
With Me.ListBox2
'add the row
.AddItem (rw.Cells(1).Value)
For i = 2 To rw.Cells.Count
.List(.ListCount - 1, i - 1) = rw.Cells(i).Value
Next i
End With
End If
Next rw
End Sub
Private Sub CommandButton15_Click() '''Hide button
Dim id, m, sh As Worksheet
If Me.ListBox2.ListIndex >= 0 Then
id = Me.ListBox2.List(Me.ListBox2.ListIndex, 0) 'adjust id column to suit
Set sh = MasterSheet
m = Application.Match(id, sh.Columns("A"), 0) 'find the id on the master sheet
If Not IsError(m) Then 'found?
sh.Cells(m, "G").Value = "Inactive" 'mark as inactive
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex 'remove from listbox
Else
'should not happen!
MsgBox "Employee Id '" & id & "' not found on Master sheet!", vbExclamation
End If
End If
End Sub
Function MasterSheet() As Worksheet
Set MasterSheet = ThisWorkbook.Worksheets(MASTER_SHEET)
End Function
I am working on Userforms in VBA for the first time. I have a calendar userform from which I select a date which is displayed on a textbox. By default the textbox shows the current day. At the bottom I have a listbox. I want to filter the data in the listbox based on the current date/date selected by the user.
I am doing this but it does produce any result in the listbox. Do I need to convert the date into some other type?
Sub Attendance_Display_Listbox()
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Attendance")
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("AttendanceDisplay")
'''Filter data datewise
dsh.UsedRange.AutoFilter 5, "=" & Me.txt_Date.Value
sh.Cells.ClearContents
dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValues
sh.Range("A1").PasteSpecial xlPasteFormats
dsh.AutoFilterMode = False
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "0,50,200,150,70,50,100,70" '0 for not displaying the Serial no
.RowSource = sh.Name & "!A2:H" & last_row
End With
End Sub
For a different date selected then -
Private Sub txt_Date_Change()
Call Attendance_Display_Listbox
End Sub
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Attendance")
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("AttendanceDisplay")
dsh.AutoFilterMode = False
dsh.Range("E:E").NumberFormat = "D-MMM-YYYY"
'''filter
dsh.UsedRange.AutoFilter 5, "=" & Me.txt_Date.Value
sh.UsedRange.Clear
dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
dsh.AutoFilterMode = False
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "0,50,200,150,70,50,100,70" '0 for not displaying the Serial no
.RowSource = sh.Name & "!A2:H" & last_row
End With
End Sub
This works!
question : how gone be the code when we want to filter the data between 2 dates
I pulled the code from a Mr. Excel post and tried to repurpose it for multiple listboxes.
I want the data entered to go across multiple rows based on different variables.
That is for it to make a row of the various combinations that are selected under the listbox.
Image link: https://imgur.com/a/cWcDwNx
I'd like the options in Screenshot 1 to return Screenshot 2, but it returns Screenshot 3.
I'd like the options in Screenshot 4 to return Screenshot 5, but it returns Screenshot 6.
Private Sub CommandButton1_Click()
Dim rng As Range
Dim i As Long
Dim A As Long
Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1)
For A = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(A) = True Then
rng.Resize(, 5).Value = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ListBox2.List(A))
Set rng = rng.Offset(1)
End If
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
rng.Resize(, 5).Value = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ListBox1.List(i), ListBox2.List(A))
Set rng = rng.Offset(1)
End If
Next i
Next A
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.List = Array("A", "B", "C")
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
End With
With ListBox2
.List = Array("Kappa", "Keepo")
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
End With
End Sub
Where am I going wrong, is it the Syntax or the entire approach?
How could do this for multiple listboxes, maybe even 4?
You need nested loops (untested)
Private Sub CommandButton1_Click()
Dim rng As Range, i As Long, j As Long, ar
Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 5)
ar = Array(TextBox1.Value,TextBox2.Value,TextBox3.Value,"","")
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ar(3) = ListBox1.List(i)
For j = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(j) = True Then
ar(4) = ListBox2.List(j)
rng.Value = ar
Set rng = rng.Offset(1)
End If
Next
End If
Next
End Sub
Part 1: A combo box in sheet1 to dynamically list unique values from a column in sheet2 put it in the drop down list
Part 2: Display the related entries of sheet2 in sheet1 based on the combo box selection.
I have done the part 1 in a method call fillCombo and have called it under ComboBox1_DropButtonClick() and part 2 under the method ComboBox1_Change()
First time when i click dropdown arrow of combo box it lists the unique entries and on making the selection in it, the related entries are displayed in sheet1 and everything is fine.
During the next selection of dropdown arrow it goes to ComboBox1_DropButtonclick() method then ComboBox1_change() method, ComboBox1_change() method without the dropdown list appearing and me selecting
So it works correctly only in the first instance.
Can you please correct the error.
Private Sub ComboBox1_Change()
Dim sht2, sht1, a As Long, X As Long, i As Long
Dim Lastrow As Long
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
a = sht2.Cells(Rows.Count, 1).End(xlUp).Row
X = 8
Lastrow = sht1.Range("D" & Rows.Count).End(xlUp).Row
sht1.Range("G8:J" & Lastrow).Clear
For i = 2 To a
If sht2.Cells(i, 3).Value = "Payments" Then
sht2.Cells(i, "C").Resize(1, 4).Copy sht1.Cells(X, "G")
X = X + 1
End If
Next
sht1.Select
sht1.Cells(1, 1).Select
End Sub
Private Sub ComboBox1_DropButtonClick()
Call fillCombo
End Sub
Sub fillCombo()
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Group = 3
firstTime = True
strValue = Sheet1.ComboBox1.Value
'last row
wsLR = ws2.Cells(Rows.Count, 1).End(xlUp).Row
'loop thru rows
For l = 2 To wsLR
If ws2.Cells(l, Group) <> "" And (InStr(uE, "|" & ws2.Cells(l, Group) & "|") = 0) Then
If firstTime = True Then
firstTime = False
uE = "|" & uE & ws2.Cells(l, Group) & "|"
Else
uE = uE & ws2.Cells(l, Group) & "|"
End If
End If
Next l
dropValues = Split(uE, "|")
Sheet1.ComboBox1.Clear
For Each cell In dropValues
If cell <> "" Then
Sheet1.ComboBox1.AddItem cell
End If
Next cell
Sheet1.ComboBox1.Value = strValue
End Sub