Create drop down list on certain cells [Solved/Closed]

Report
Posts
41
Registration date
Thursday June 16, 2011
Status
Member
Last seen
May 7, 2014
-
venkat1926
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
Good day,

I wanted to create a drop down list from data in Sheet2. I have tried the following codes but the outcome seems to be incorrect. Instead of the data in Sheet2 listed in the drop down list, the drop down list contained the data from Sheet1 (which is my destination sheet).

Also, I would like to have the drop down list on certain cells where I have information on the cells before, i.e. the drop down list should be in Column F of Sheet1 where there is information on Column E of Sheet1 and repeat until the end of the list.

Herewith attached is the file I am working on.

http://speedy.sh/9qyWh/6000-SEQ-PLAN-PACKAGING-Rev2.0.xlsm

Appreciate the help from everyone.

Thank you.

Best regards,
wliang

6 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
when You create a validation list from ANOTHER WORKSHEET give a range name to that validation list(in sheet2)
and use that as the formula

I tried to modify your macro without disturbing except changing one or two lines
I have given range name as "rangename". you can change it in the macro

if necessary tweak it little more.

Sub Dropdown()
Dim x As Long, y As Long
Dim objCell As Range
Dim objDataRangeStart As Range
Dim objDataRangeEnd As Range
Dim rangename As String
' >> Set The Range For Valid Data
Set wsSourceList = Sheets("Sheet2")
Set wsDestList = Sheets("Sheet1")
Set objDataRangeStart = wsSourceList.Cells(1, 2) 'Start range for dropdown list entries
Set objDataRangeEnd = wsSourceList.Cells(6, 2) 'End range for dropdown list entries
MsgBox objDataRangeStart
MsgBox objDataRangeEnd
'=================
With Worksheets("Sheet2")
Range(objDataRangeStart, objdatarangaeend).Name = "rangename"
End With
'=====================
' >> Set Validation On Required Cell
'Set objCell = wsDestList.Cells(8, 4) 'Location of the dropdown list
'MsgBox objCell
x = 4
y = 6

Do
Set objCell = wsDestList.Cells(x, y) 'Location of the dropdown list

With objCell.Validation
  .Delete
  '.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & objDataRangeStart.Address & ":" & objDataRangeEnd.Address
  '===========================================
  .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=rangename"
  '================================================================
  .IgnoreBlank = True
  .InCellDropdown = True
  .ErrorTitle = "Warning"
  .ErrorMessage = "Please select a value from the list available in the selected cell."
  .ShowError = True
End With
x = x + 1
'y = y + 1
Loop Until x = 51

End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 3912 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
it will be a good practice not to leave blank rows except at the beginning.
no blank collumns also
preferably no blank cell. fill them with 0s or Xs

I have given you a new macro "dropdown_revised"

try that

Sub dropdown_revised()
Dim r2 As Range, r1 As Range, rangename As String, llastrow As Long, lastscell

Worksheets("sheet1").Activate
Range("a4").End(xlToRight).Offset(0, 1).EntireColumn.Cells.Select
Selection.Clear


With Worksheets("sheet2")
Set r2 = Range(.Range("B1"), .Range("B1").End(xlDown))
r2.Name = "rangename"
End With
With Worksheets("sheet1")
Set r1 = .Range("a4").End(xlToRight).Offset(0, 1)
Set llastcell = Cells.SpecialCells(xlCellTypeLastCell)
llastrow = llastcell.Row
MsgBox llastrow
Set r1 = Range(r1, .Cells(llastrow, r1.Column))
r1.Validation.Add xlValidateList, , , Formula1:="=rangename"
End With
End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 3912 users have said thank you to us this month

Posts
41
Registration date
Thursday June 16, 2011
Status
Member
Last seen
May 7, 2014

Hi venkat1926,
Thank you very much for your help. After taking in your suggestion, the macro seems to work fine now.

Referring to the second part of my question, I have put in the codes as below to create the drop down list on rows that have entries. For example, if there is data in Column B, then create the drop down list on Column F and repeat until there is no data in 2 consecutive columns in Column B. You can refer to my previous attachment.

Below are the codes but I hit with errors and unable to proceed.

====================================================
Sub Dropdown()
Dim x As Long, y As Long
Dim objCell As Range
Dim objDataRangeStart As Range
Dim objDataRangeEnd As Range
Dim rangename As String, cfind As Range
Dim a As Range

Set wsSourceList = Sheets("Sheet2")
Set wsDestList = Sheets("Sheet1")
Set objDataRangeStart = wsSourceList.Cells(1, 2)
Set objDataRangeEnd = wsSourceList.Cells(6, 2)

With Worksheets("Sheet2")
Range(objDataRangeStart, objDataRangeEnd).Name = "rangename"
End With

x = 5
y = 6

Set cfind = wsDestList.Columns("B:B").Cells.Find(what:="*", LookAt:=xlWhole)

Do
For Each x In Range(cfind, Cells(Rows.Count, cfind.Column).End(xlUp))
Set objCell = wsDestList.Cells(x, y) 'Location of the dropdown list

With objCell.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=rangename"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "Warning"
.ErrorMessage = "Please select a value from the list available in the selected cell."
.ShowError = True
End With
x = x + 1

Next x
Loop Until cfind = ""

End Sub
===================================================

Please advise.

Thanking you in advance for your help.

Best regards,
wliang
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
put n single apostrophe before thelilne
msgbox llastrow


so that no alert message will pop up
Posts
41
Registration date
Thursday June 16, 2011
Status
Member
Last seen
May 7, 2014

Hi venkat1926,

I have tried out the revised macro and it works fine. Thank you very much for your help.

Best regards,
wliang
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
789
welcome. good that it worked