S
sjvenz
I have been trying to display multiple values in a LB on a form.
I have two LB's
LB1 displays employee details - row AH17:ah124
LB2 displays Courses required - rowAJ17:AJ124
I can get LB2 to display the courses require when an employee is
selected in LB1., The problem I'm having is that I am trying to get the
Courses that have a value of "no" (row ak17:ak124) to be highlighted.
Has anyone any ideas, have been trying for awhile to get this to work.
Any help would be greatly appreciated.
I also get an error - Object variable or With block variable not set.
I'm also trying to then paste these values when selected onto another
workbook...is this possible
The following is the code I'm using:
Private Sub UserForm_initalize()
Dim myrange As Range
Dim Cell As Range
Dim a As Integer
Set myrange = Sheets("view daily").Range("aj17:aj124")
For Each Cell In myrange
ListBox1.AddItem Cell.Value
ListBox2.AddItem Cell.Value
If Cell.Offset(0, 1).Value = "no" Then
ListBox2.Selected(a) = True
Else
ListBox2.Selected(a) = False
End If
a = a + 1
Next
End Sub
Private Sub ListBox1_Change()
Dim AllCells As Range
Dim myrange As Range
Dim Cell As Range
Dim Index As Integer
Dim RowSelected As Integer
Set AllCells = Sheets("view daily").Range("ah17:ah124")
ListBox2.Clear
RowSelected = 0
For Index = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(Index) Then
RowSelected = Index
End If
Next
For Each Cell In AllCells
If Cell.Value = CLng(ListBox1.List(RowSelected)) Then
ListBox2.AddItem Cell.Offset(0, 2).Text
End If
' Note: the 2nd argument (key) for the Add method must be a
string
' End If
Next Cell
End Sub
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in ah17:ak124
Set AllCells = Range("ah17:ah124")
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a
string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
frm_DAILYSignINsheet.ListBox1.AddItem Item
Next Item
' Show the UserForm
frm_DAILYSignINsheet.Show
End Sub
I have two LB's
LB1 displays employee details - row AH17:ah124
LB2 displays Courses required - rowAJ17:AJ124
I can get LB2 to display the courses require when an employee is
selected in LB1., The problem I'm having is that I am trying to get the
Courses that have a value of "no" (row ak17:ak124) to be highlighted.
Has anyone any ideas, have been trying for awhile to get this to work.
Any help would be greatly appreciated.
I also get an error - Object variable or With block variable not set.
I'm also trying to then paste these values when selected onto another
workbook...is this possible
The following is the code I'm using:
Private Sub UserForm_initalize()
Dim myrange As Range
Dim Cell As Range
Dim a As Integer
Set myrange = Sheets("view daily").Range("aj17:aj124")
For Each Cell In myrange
ListBox1.AddItem Cell.Value
ListBox2.AddItem Cell.Value
If Cell.Offset(0, 1).Value = "no" Then
ListBox2.Selected(a) = True
Else
ListBox2.Selected(a) = False
End If
a = a + 1
Next
End Sub
Private Sub ListBox1_Change()
Dim AllCells As Range
Dim myrange As Range
Dim Cell As Range
Dim Index As Integer
Dim RowSelected As Integer
Set AllCells = Sheets("view daily").Range("ah17:ah124")
ListBox2.Clear
RowSelected = 0
For Index = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(Index) Then
RowSelected = Index
End If
Next
For Each Cell In AllCells
If Cell.Value = CLng(ListBox1.List(RowSelected)) Then
ListBox2.AddItem Cell.Offset(0, 2).Text
End If
' Note: the 2nd argument (key) for the Add method must be a
string
' End If
Next Cell
End Sub
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
' The items are in ah17:ak124
Set AllCells = Range("ah17:ah124")
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a
string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
frm_DAILYSignINsheet.ListBox1.AddItem Item
Next Item
' Show the UserForm
frm_DAILYSignINsheet.Show
End Sub