Multiple combo boxes refenrencing the same range/list without repeating choices.

dnomyar

New Member
Joined
Jul 24, 2015
Messages
10
Hello! I hope someone can help me. I am desperately trying to accomplish the following;

I have an userform(FormEntry) with 6 combo boxes. However, all 6 combo boxes reference the same range(Courses) under column "C" in sheet(Ranges-Lists). What I need is for the boxes to continue referencing the same range(Courses) under column "C", but that if the selection on the first combo box is "math", then the remaining combo boxes will no longer have "math" as an option.

I currently have VBA set up to "ignore blank cells" within a range. I wish to maintain that, but also add the function mentioned above; I need combo box 6 to have 5 less options than what combo box 1 had available.

This is the code that I currently have, which works perfect(with the exception of leaving out prior choices):
With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses1.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses2.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses3.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses4.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses5.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses6.AddItem cell.Value
Next cell
End With

End Sub
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hello! I hope someone can help me. I am desperately trying to accomplish the following;

I have an userform(FormEntry) with 6 combo boxes. However, all 6 combo boxes reference the same range(Courses) under column "C" in sheet(Ranges-Lists). What I need is for the boxes to continue referencing the same range(Courses) under column "C", but that if the selection on the first combo box is "math", then the remaining combo boxes will no longer have "math" as an option.

I currently have VBA set up to "ignore blank cells" within a range. I wish to maintain that, but also add the function mentioned above; I need combo box 6 to have 5 less options than what combo box 1 had available.

This is the code that I currently have, which works perfect(with the exception of leaving out prior choices):
With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses1.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses2.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses3.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses4.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses5.AddItem cell.Value
Next cell
End With

With Worksheets("Ranges-Lists")
For Each cell In .Range("C2:C50" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Courses6.AddItem cell.Value
Next cell
End With

End Sub


dnomyar,
I copied this bit of code quite a while ago from this forum...It does not exactly fit your needs, but you might be able to adapt to 'Combo Boxes' instead of Data Validation dropdowns...I have not used Combo Boxes so I am not an expert on them...just thought it might get you going in the right direction.
Perpa


"Limiting Choices in a drop down list based on choices already made in a worksheet"

The names are in H1:H10, and the drop down data valadation refers to it.
Cell B1 has the drop down.
When a name is selected in B1 it is removed from column H and put into column G and the word "Scheduled"
takes its place in column H.
To reset the list in Column H to a full spectrum of previous names, run "Sub ReSetScheduleList()"
Code:
	Option Explicit
	Private Sub Worksheet_Change(ByVal Target As Range)
	If Target.Address <> "$B$1" Then Exit Sub
	Dim c As Range
	For Each c In Range("H1:H10")
	 If Range("B1").Value = "Scheduled" Then Exit Sub
	 If c.Value = Range("B1").Value Then
	     c.Cut c.Offset(0, -1)
	     c.Offset(0, 1) = "Scheduled"
	 End If
	Next
	End Sub
	
	Sub ReSetScheduleList()
	Dim c As Range
	For Each c In Range("G1:G10")
	 If c.Value <> "" Then
	   c.Cut c.Offset(0, 1)
	 End If
	Next
	End Sub
 
Upvote 0
Thank you so much, Perpa! That bit of code made me think of another way to ask the question and then I was able to answer it myself. I was wondering if you or anyone else have an idea for this next problem I'm having.

I have my userform set up with all the combo boxes. One of the Combo boxes(NamesDropDown) includes the names of all the students. As stated above each of the 6 combo boxes has the list of courses. I also have other text boxes in the same userform that will collect grades. What I need is that everytime I click on my submit button, all the information will be transferred to a spreadsheet(Dates). This spreadsheet collects the dates that the students passed the course.

I need it to know that based on the student's name(picked from NameDropDown and ALREADY listed under column "C" on the worksheet) it will provide the date that the course was completed appropriately. The courses are listed from left to right on columns "D" through "P".

The students names are already listed on the spreadsheet by referencing a different range. I want the submit button to be smart enough to allocate the data on its own. I've done different versions of this code before, but for some reason I just don't know where to start now. Please Help!... :)

On the UserForm the date the course was passed is taken from DateBox.
 
Upvote 0
Thank you so much, Perpa! That bit of code made me think of another way to ask the question and then I was able to answer it myself. I was wondering if you or anyone else have an idea for this next problem I'm having.

I have my userform set up with all the combo boxes. One of the Combo boxes(NamesDropDown) includes the names of all the students. As stated above each of the 6 combo boxes has the list of courses. I also have other text boxes in the same userform that will collect grades. What I need is that everytime I click on my submit button, all the information will be transferred to a spreadsheet(Dates). This spreadsheet collects the dates that the students passed the course.

I need it to know that based on the student's name(picked from NameDropDown and ALREADY listed under column "C" on the worksheet) it will provide the date that the course was completed appropriately. The courses are listed from left to right on columns "D" through "P".

The students names are already listed on the spreadsheet by referencing a different range. I want the submit button to be smart enough to allocate the data on its own. I've done different versions of this code before, but for some reason I just don't know where to start now. Please Help!... :)

On the UserForm the date the course was passed is taken from DateBox.

dnomyar,
You haven't shown how the userform is set up, maybe a screen shot.
How does the 'DateBox' work?
Ideally, the DateBox can be triggered to fire when the grade is selected,
then the date could be copied into the appropriate column below the course, and grade.
Alternatively…
Have a DateBox below each grade that you manually select when the grade is entered for each course.

Something like the following ( Course1, Grade1, Date1 would all be in the same column, same for 2, 3 etc):
Names_DD
Course1 Course2 Course3 Course4 Course5 Course6
Grade1 Grade2 Grade3 Grade4 Grade5 Grade6
Date1 Date2 Date3 Date4 Date5 Date6
SUBMIT

Here are a couple of macro examples that may help:

Linking list/combo box selections to macros:

Code:
     If combobox1.value = "YourCBoxSelectionHere" Then
	Macro1
     elseif combobox1.value= "NextCBoxSelectionHere" Then
	Macro2
     elseif
     End if

Change the stuff in "" to whatever the selections are in your combobox
and change the Macro1, Macro2 to the names of your macros.

Or...To move data to the sheet "Dates":

Code:
Private Sub CommandButton1_Click()

'This next line copies  from worksheet Active worksheet to worksheet "Dates"		
Sheets("Dates").Range("G11") = ComboBox1.Value
Sheets("Dates").Range("G12") = ComboBox2.Value
....etc
Sheets("Dates").Range("G16") = ComboBox6.Value	
End Sub

Change the Range values to suit your worksheet "Dates".

Perpa
 
Upvote 0
Perpa,

I have tried everything to post a screen shot of the user form and of the worksheet where the data is supposed to be inputed. Maybe you have some pointers on how to do that? Anyways, I am posting all the code that I have for my User Form. Again, what I am trying to do is:
Having the names of the students listed under Column "C" and all the courses listed on Row 1 starting on Column "D", the code will detect the student's name, find the row under Column "C" that contains that student's name and then apply the date entered in the user form somewhere after the student's name(on the same row, just a different column... the column where
the course title is the first cell of the column). It's practically like playing Battleship. Again, the course titles are listed as math, english, spanish, science... starting with Column "D", "E", and so on The date comes from my datebox on the userform. Thank you to the person that can figure this out. I'm not the best at this. Please look at the red text... that's where the problem lies.
I tried playing around with the last code you provided, but I quickly realized that it wouldn't work since the code has to detect that the name of the student picked from the StudentNameDropDowncan be found in Column "C", after it finds the student's name it has to deposit the date on DateBox under the columns titled "Math" or "English" or whatever the value of the 6 combo boxes is.
I have the screenshots to post, I just am unable to. Course1, Course2, Course3, Course4, Course5, and Course6 are the combo boxes. Again, the red portion of the code is where I'm stuck.



Code:
Private Sub Course1_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course1.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course1.ListIndex > -1 Then ScoreBox1.SetFocus

End Sub
---
Private Sub Course1_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course1.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Function CreateArray(r As Range)

Dim col As New Collection, c As Range, TempArray(), i As Long

For Each c In r

On Error Resume Next

col.Add c.Value, CStr(c.Value)

If Err.Number = 0 And Trim(c) <> "" Then

ReDim Preserve TempArray(i)

TempArray(i) = c.Value

i = i + 1

End If

Err.Clear

Next

CreateArray = TempArray

Erase TempArray

End Function
---
Private Sub Course2_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course2.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course2.ListIndex > -1 Then ScoreBox2.SetFocus

End Sub
---
Private Sub Course2_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course2.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course3_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course3.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course3.ListIndex > -1 Then ScoreBox3.SetFocus

End Sub
---
Private Sub Course3_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course3.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course4_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course4.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course4.ListIndex > -1 Then ScoreBox4.SetFocus

End Sub
---
Private Sub Course4_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course4.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course5_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course5.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course5.ListIndex > -1 Then ScoreBox5.SetFocus

End Sub
---
Private Sub Course5_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course5.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course6_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course6.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course6.ListIndex > -1 Then ScoreBox6.SetFocus

End Sub
---
Private Sub Course6_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course6.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub DateButton_Click()

DateBox.Text = Date

End Sub
---
[COLOR=#FF0000]Private Sub SubmitButton_Click()

Dim LastRow As Long

Dim ws As Worksheet

Dim r As Range

Set ws = Sheets("Data Entry")

For Each r In
Range("C2:C56")

If r.Value = StudentNameDropDown.Text Then

LastRow = (r & Range("D"))

ws.Range("D" & LastRow).Value = DateBox.Value 

End With?
[/COLOR]
Worksheets("Data Entry").Range("CoursesDuplicate").Value = Worksheets("Ranges-Lists").Range("Courses").Value

End Sub
---
Private Sub UserForm_Initialize()

Dim cell As Range

With Worksheets("Ranges-Lists")

For Each cell In .Range("I2:I50" & .Cells(Rows.Count,
3).End(xlUp).Row)

If Not IsEmpty(cell) Then InstructorDropDown.AddItem cell.Value

Next cell

End With

With
Worksheets("Ranges-Lists")

For Each cell In .Range("D2:D50" & .Cells(Rows.Count,
3).End(xlUp).Row)

If Not IsEmpty(cell) Then StudentNameDropDown.AddItem cell.Value

Next cell

End With
End Sub
---
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Worksheets("Data Entry").Range("CoursesDuplicate").Value = Worksheets("Ranges-Lists").Range("Courses").Value

End Sub
 
Upvote 0
Perpa,

I have tried everything to post a screen shot of the user form and of the worksheet where the data is supposed to be inputed. Maybe you have some pointers on how to do that? Anyways, I am posting all the code that I have for my User Form. Again, what I am trying to do is:
Having the names of the students listed under Column "C" and all the courses listed on Row 1 starting on Column "D", the code will detect the student's name, find the row under Column "C" that contains that student's name and then apply the date entered in the user form somewhere after the student's name(on the same row, just a different column... the column where
the course title is the first cell of the column). It's practically like playing Battleship. Again, the course titles are listed as math, english, spanish, science... starting with Column "D", "E", and so on The date comes from my datebox on the userform. Thank you to the person that can figure this out. I'm not the best at this. Please look at the red text... that's where the problem lies.
I tried playing around with the last code you provided, but I quickly realized that it wouldn't work since the code has to detect that the name of the student picked from the StudentNameDropDowncan be found in Column "C", after it finds the student's name it has to deposit the date on DateBox under the columns titled "Math" or "English" or whatever the value of the 6 combo boxes is.
I have the screenshots to post, I just am unable to. Course1, Course2, Course3, Course4, Course5, and Course6 are the combo boxes. Again, the red portion of the code is where I'm stuck.



Code:
Private Sub Course1_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course1.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course1.ListIndex > -1 Then ScoreBox1.SetFocus

End Sub
---
Private Sub Course1_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course1.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Function CreateArray(r As Range)

Dim col As New Collection, c As Range, TempArray(), i As Long

For Each c In r

On Error Resume Next

col.Add c.Value, CStr(c.Value)

If Err.Number = 0 And Trim(c) <> "" Then

ReDim Preserve TempArray(i)

TempArray(i) = c.Value

i = i + 1

End If

Err.Clear

Next

CreateArray = TempArray

Erase TempArray

End Function
---
Private Sub Course2_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course2.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course2.ListIndex > -1 Then ScoreBox2.SetFocus

End Sub
---
Private Sub Course2_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course2.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course3_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course3.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course3.ListIndex > -1 Then ScoreBox3.SetFocus

End Sub
---
Private Sub Course3_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course3.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course4_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course4.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course4.ListIndex > -1 Then ScoreBox4.SetFocus

End Sub
---
Private Sub Course4_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course4.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course5_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course5.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course5.ListIndex > -1 Then ScoreBox5.SetFocus

End Sub
---
Private Sub Course5_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course5.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub Course6_Change()

Dim Found As Range

Set Found = Worksheets("Data Entry").Columns("AZ").Find(what:=Me.Course6.Value, LookIn:=xlValues, lookat:=xlWhole)

Found.Delete

If Course6.ListIndex > -1 Then ScoreBox6.SetFocus

End Sub
---
Private Sub Course6_DropButt*******()

Dim LR As Long

LR = Cells(Rows.Count, "AZ").End(xlUp).Row

Course6.List() = CreateArray(Range("AZ2:AZ56" & LR))

End Sub
---
Private Sub DateButton_Click()

DateBox.Text = Date

End Sub
---
[COLOR=#FF0000]Private Sub SubmitButton_Click()

Dim LastRow As Long

Dim ws As Worksheet

Dim r As Range

Set ws = Sheets("Data Entry")

For Each r In
Range("C2:C56")

If r.Value = StudentNameDropDown.Text Then

LastRow = (r & Range("D"))

ws.Range("D" & LastRow).Value = DateBox.Value 

End With?
[/COLOR]
Worksheets("Data Entry").Range("CoursesDuplicate").Value = Worksheets("Ranges-Lists").Range("Courses").Value

End Sub
---
Private Sub UserForm_Initialize()

Dim cell As Range

With Worksheets("Ranges-Lists")

For Each cell In .Range("I2:I50" & .Cells(Rows.Count,
3).End(xlUp).Row)

If Not IsEmpty(cell) Then InstructorDropDown.AddItem cell.Value

Next cell

End With

With
Worksheets("Ranges-Lists")

For Each cell In .Range("D2:D50" & .Cells(Rows.Count,
3).End(xlUp).Row)

If Not IsEmpty(cell) Then StudentNameDropDown.AddItem cell.Value

Next cell

End With
End Sub
---
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Worksheets("Data Entry").Range("CoursesDuplicate").Value = Worksheets("Ranges-Lists").Range("Courses").Value

End Sub

dnomyar,

I noticed that you have posted this same code at the following thread:

Click Me!

Since you are getting help from others with that post, I will follow your progress on that thread and
comment there if I have anything else to contribute. Good luck.

Perpa
 
Upvote 0
haha!.... yes, that's me... the best shot I got was Diddi's
Code:
Worksheets("Data Entry").Cells(MemberNameDropDown.ListIndex + 1, "D") = DateBox.Value

but this only pastes the date on whatever column is inputed to the code itself. I need it to determine which column has the actual courses that get chosen from the userform.
 
Upvote 0

Forum statistics

Threads
1,223,249
Messages
6,171,031
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top