CODEWITHSUNDEEP
excellistvbadrop-down-menunamed-ranges
H3lue
H3lue

Reputation: 1101

Creating Multiple Data Validation Lists Without Referring to Same Range EXCEL VBA

I am writing a Macro in excel VBA that creates a data validation list in a specified cell. The program then prompts the user for the cells which contain the contents of the data validation lists. The same rows containing the list contents are then to be hidden from view. However, when I try to rerun the macro multiple times, each time I select a new range for contents, each of the proceeding lists then refers to this range. I DO NOT want this to happen.

I wrote this line of code to prevent this:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

Where strRng is the name of the range to refer to when adding to the data validation. However, for some reason this does not work. I thought this would work because it would create independent names for each of the ranges to be added to a list. But it does not...

Here is the entire code:

Sub CreatDropDownList()
Dim strRange As String
Dim celNm As Range
Dim celNm2 As Range 'use only if necessary
Dim celRng As Range
Dim strRngNumLbl As Integer
Dim nm As Name


On Error GoTo pressedCancel:

Set celNm = Application.InputBox(Prompt:= _
                "Please select a cell to create a list.", _
                   Title:="SPECIFY Cell", Type:=8)

If celNm Is Nothing Then Exit Sub

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?


'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

'cell range equal to nothing
Set celRng = Nothing

'asks user to determine range of strings
Set celRng = Application.InputBox(Prompt:= _
    "Please select the range of cells to be included in list.", _
        Title:="SPECIFY RANGE", Type:=8)

If celRng Is Nothing Then Exit Sub
On Error GoTo 0

strRange = "DataRange"
strRngNumLbl = 1

'Increments strRngNumLblb for the number of names present in the workbook to
'ensure list is not referring to duplicate ranges
For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

'user defined data range is now called strRange, refer to it as Range(strRange)
ThisWorkbook.Names.Add Name:=strRange, RefersTo:=celRng

'format the refernce name for use in Validation.add
strRange = "=" & strRange

celNm.Offset(-1, 0).Select

'Add the drop down list to the target range using the list range
celNm.Validation.Delete
celNm.Validation.Add xlValidateList, , , strRange

'hide the range where the list came from
celRng.EntireRow.Hidden = True

pressedCancel:
End Sub

Any suggestions?

Upvotes: 0

Views: 2729

Answers (2)

H3lue
H3lue

Reputation: 1101

I was able to solve this problem simply by checking if the strRange name was already in ThisWorkbook.names. Here is an edit to the code above:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNumLbl + 1
    strRange = strRange & strRngNumLbl
    If strRange = nm Then
        strRngNumLbl = strRngNumLbl + 1
        strRange = strRange & strRngNumLbl
    End If
Next nm

Upvotes: 1

JMax
JMax

Reputation: 26611

Solving your issue

Instead of:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm

You should have:

strRngNumLbl = ThisWorkbook.Names.Count + 1

Some tips or questions about your code

i don't understand what's the use of this part of code:

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?

'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

i don't understand either this part. Moreover, this could cause an error if the user select a cell in the column A

celNm.Offset(0, -1).Value = "N/A"

Hope that helps,

Upvotes: 1

Related Questions