Please need VBA code: Select records from drop down list

[jduck]

Can someone please help with a bit of code. I'm new to the VBA stuff and have an immediate need that I'm not able to figure out just yet.

I have a spreadsheet that contains multiple rows per user. I need a combo or list box that pops up asking them to select their name from the drop down list. The list would be based on column A and would only include their name once.

When they select their name, the macro would then open the Form option from the Data menu, the Criteria button would be pushed and their name entered into the form, to return the first record their name appears on, then they could forward through the records, and update using the Next record button.

Any help would be greatly appreciated, as I'm just not getting the hang of this stuff very quickly. I'm studying as vigerously as possible. The learning curve just isn't meeting this need quickly enough.

 

[stanleydgromjr]

Joe,

I had no problems.

I put the source list in Sheet2, beginning in cell A2, and your macro created the pull-down unique list in Sheet2, cell B1.

Have a great day,
Stan

 

[Joe Was]

Thanks Stan.

If we can get it to work for the original poster, I may add a property option for the Drop-Down Sheet as this is an easy addition.
I wonder what is causing the original poster to have problems?

 

[jduck]

Thanks Stan. I'm about out for the week, but will go at it again Monday.

 

[jduck]

Sorry, I meant, Thanks JOE!

 

[jduck]

Ok, tried it one last time, failed again. I'm going to try monday with a fresh spreadsheet b/c this doesn't seem to make sense.

 

[Joe Was]

Updated the code to also give you the option of putting the Drop-Down List on a Sheet the Same or Different from the Data List of Items. And, added additional Error Trapping!

With the the help of Denis AKA: SydneyGeek, the variables have been refined as well.

Before running this code, please check the "User Defined, SetUp Parameters" in the code below and adjust these as needed!


Sub MakeDDList()
'Standard module code, like: Module1.
'UpTo 64 Unique items added to an in cell Drop-Down List, from a list of any size.
Dim strCol$, strDDLCell$, strMyList$, strSheetNm$, strDDLSheet$
Dim lngBotOfList&, lngColNum&, lngRowToStartWith&, lngItem&
Dim objDataRng As Object, objUniqueList As Object
Dim objMyCell As Object
Dim varCellVal As Variant, varMyTest As Variant

'**** Start: User Defined, SetUp Parameters *******************************************
'The Sheet's Name containing the items for the unique list?
strSheetNm = "Sheet2"

'The column containing the items for the unique list?
strCol = "A"

'The actual First Data Row [not its label row!] of the items list?
lngRowToStartWith = 2

'Sheet Name for the Sheet that gets the Drop-Down List?
strDDLSheet = "Sheet1"

'The Cell that gets the Drop-Down List?
strDDLCell = "B1"
'**** End: User Defined, SetUp Parameters *******************************************

Application.ScreenUpdating = False

lngColNum = Sheets(strSheetNm).Range(strCol & ":" & strCol).Column
lngBotOfList = Sheets(strSheetNm).Range(strCol & "65536").End(xlUp).Row

If Not (lngBotOfList - lngRowToStartWith) > 0 Then GoTo myListErr

Set objDataRng = Sheets(strSheetNm).Range(Cells(lngRowToStartWith, lngColNum), _
Cells(lngBotOfList, lngColNum))

Sheets.Add
ActiveSheet.Name = "TempList"

objDataRng.Copy Destination:=Worksheets("TempList").Range("A1")

Worksheets("TempList").Columns("A:A").Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Set objUniqueList = Sheets("TempList").Range("A1:A" & _
Sheets("TempList").Range("A65536").End(xlUp).Row)

For Each objMyCell In objUniqueList
varCellVal = objMyCell.Value

If (varCellVal <> "" And varCellVal <> varMyTest) Then _
strMyList = strMyList & objMyCell.Value & ","

lngItem = lngItem + 1
varMyTest = Sheets("TempList").Range("A" & lngItem).Value
Next objMyCell

strMyList = Left(strMyList, Len(strMyList) - 1)

Application.DisplayAlerts = False
Sheets("TempList").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

On Error GoTo myRS
With Sheets(strDDLSheet).Range(strDDLCell).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=strMyList

.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With

GoTo myRS

myListErr:
MsgBox "Adjust the settings!" & vbLf & _
"The Items List Settings," & vbLf & _
"does not point to your Items List." & vbLf & _
"Or, Your list of Items is Empty!", _
vbCritical + vbOKOnly, _
"Items List Error!"
Exit Sub

myRS:
Sheets(strDDLSheet).Select
Sheets(strDDLSheet).Range(strDDLCell).Activate
End Sub

 

[Joe Was]

With the help of Dan AKA: HalfAce.

It looks like you can have a large Raw Data list, but the Validation Drop-Down List will not list more than 64 unique items from any list.

For more than 64 Unique Items a ListBox will be needed.

Help indicated: "The maximum number of entries that you can have in a drop-down list is 32,767."

So, I do not know why Dan got 32 and I got 64 as the limit of the Validation Drop-Down List?

 

[jduck]

Thanks again Joe. I was able to start with a fresh set of data and it worked out well. Thanks for taking the time to help out with this.

 

[jduck]

Thanks again Joe. I was able to start with a fresh set of data and it worked out well. Thanks for taking the time to help out with this.

 

[triff]

Joe
Why did you use the line
varMyTest = Sheets("TempList").Range("A" & lngItem).Value
Couldn't you have just said
varMyTest = varCellValue

Michael