CODEWITHSUNDEEP
excelexcel-2010vba
Josh McKearin
Josh McKearin

Reputation: 742

Addressing a Dynamic Named Range inside of Select Case

I am building a page where Col H should be a drop down box which is dependent on Col A.

Col A is already set up to use Validation List using a Dynamic Named Range which is specified on a hidden sheet named Data.

Also, on the Data sheet, I have specified the 3 lists which are dependent on Col A and have already made them a Dynamic Named Range as well.

So far, in VB code, I have

  1. Taken the first word, before a comma, from the selection made in Col A and used that as my "Group" identifier.

  2. Capitalized all text inputted to Col B (not relevant).

Now, I need to specify what to make as possible selections in Col H. You can see in the case "Desktop" my attempt to do this, however, it does not work and gives me an "Object Required" error.

Old Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Value <> "" And InStr(1, Target.Value, ",") Then
            Select Case Split(Target.Value, ",")(0)
               Case "Desktop": Range("H" & Target.row).Value = 
                    Data.Range("List_Desktops").Address
               Case "Laptop":  Range("H" & Target.row).Value = "Laptop"
               Case "Server":  Range("H" & Target.row).Value = "Server"
               Case Else:      Range("H" & Target.row).Value = "N/A"
            End Select
        End If
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

New Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, LastRow As Long, n As Long
    Dim MyCol As Collection
    Dim SearchString As String, TempList As String

    On Error GoTo Whoa

    Application.EnableEvents = False

     '~~> Find LastRow in List_Descriptions
    LastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).row

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Set MyCol = New Collection

         '~~> Get the data from List_Descriptions into a collection
        For i = 1 To LastRow
            If Len(Trim(Sheet2.Range("A" & i).Value)) <> 0 Then
                On Error Resume Next
                MyCol.Add CStr(Sheet2.Range("A" & i).Value), CStr(Sheet2.Range("A" & i).Value)
                On Error GoTo 0
            End If
        Next i

        '~~> Create a list for the DV List
        For n = 1 To MyCol.Count
            TempList = TempList & "," & MyCol(n)
        Next

        TempList = Mid(TempList, 2)

        Range("A" & Target.row).ClearContents: Range("A" & Target.row).Validation.Delete

        '~~> Create the DV List
        If Len(Trim(TempList)) <> 0 Then
            With Range("A" & Target.row).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    '~~> Capturing change in cell D1
    ElseIf Not Intersect(Target, Range("A" & Target.row)) Is Nothing Then
        SearchString = Range("A" & Target.row).Value

        TempList = FindRange(Sheet2.Range("A1:A" & LastRow), SearchString)

        Range("H" & Target.row).ClearContents: Range("H" & Target.row).Validation.Delete

        If Len(Trim(TempList)) <> 0 Then
            '~~> Create the DV List
            With Range("H" & Target.row).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If

    If Target.Value <> "" And InStr(1, Target.Value, ",") Then
        Select Case Split(Target.Value, ",")(0)
            Case "Desktop": Range("H" & Target.row).Value = "Desktop"
            Case "Laptop":  Range("H" & Target.row).Value = "Laptop"
            Case "Server":  Range("H" & Target.row).Value = "Server"
            Case Else:      Range("H" & Target.row).Value = "N/A"
        End Select
    End If
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Dim strTemp As String

    Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    ExitLoop = False

    If Not aCell Is Nothing Then
        Set bCell = aCell
        strTemp = strTemp & "," & aCell.Offset(, 1).Value
        Do While ExitLoop = False
            Set aCell = FirstRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                strTemp = strTemp & "," & aCell.Offset(, 1).Value
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = Mid(strTemp, 2)
    End If
End Function

SAMPLE WORKBOOK: https://docs.google.com/open?id=0B9ss2136xoWIVGxQYUJJX2xXc00

Upvotes: 0

Views: 4610

Answers (1)

Josh McKearin
Josh McKearin

Reputation: 742

Alright, I figured it out. Thank you so much Siddharth Rout for your assistance on this! For those who may would like to view the code in the future, here it is:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, LastRow As Long, n As Long
    Dim MyCol As Collection
    Dim SearchString As String, TempList As String

    On Error GoTo Whoa

    Application.EnableEvents = False

If Not Intersect(Target, Columns(1)) Is Nothing Then
 If Not Intersect(Target, Range("A" & Target.row)) Is Nothing Then
    Range("H" & Target.row).ClearContents: Range("H" & Target.row).Validation.Delete

    If Target.Value <> "" And InStr(1, Target.Value, ",") Then
        Select Case Split(Target.Value, ",")(0)
            Case "Desktop"
                With Range("H" & Target.row).Validation
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=List_DesktopConfigs"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
           Case "Laptop"
                With Range("H" & Target.row).Validation
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=List_LaptopConfigs"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            Case "Server"
                With Range("H" & Target.row).Validation
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=List_ServerConfigs"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            Case Else
                Range("H" & Target.row).Value = "N/A"
        End Select
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
    End If
End If
End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Function FindRange(FirstRange As Range, StrSearch As String) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Dim strTemp As String

    Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    ExitLoop = False

    If Not aCell Is Nothing Then
        Set bCell = aCell
        strTemp = strTemp & "," & aCell.Offset(, 1).Value
        Do While ExitLoop = False
            Set aCell = FirstRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                strTemp = strTemp & "," & aCell.Offset(, 1).Value
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = Mid(strTemp, 2)
    End If
End Function

Upvotes: 1

Related Questions