Saving Range as Name result in shifted Range

Viewed 40

I've created a macro to fill in some data, and it also should put out a dropdown menu in the cell G2 for the list I've created in column O, I've made the range that should be the reference point dynamic. Next I want to name said range and save it under a specific name, and then use that name as reference for the dropdown.

It works for me and some users that need to use that macro, but some (including the head of the department for whom I've made the macro) get error 1004 (Application-defined or Object-defined error) when trying to run the macro

Dim MyRange As Range
rowcounter = Cells(Rows.count, "O").End(xlUp).Row

For x = 1 To rowcounter
        If MyRange Is Nothing Then
            Set MyRange = Cells(x, "O")
        Else
            Set MyRange = Union(MyRange, Cells(x, "O"))
        End If
Next x

Dim NewFormula1 as string: NewFormula1 = "=" & MyRange

        Range("G2").Select
    With Selection.Validation
        .Delete
        .Add _
          Type:=xlValidateList, _
          AlertStyle:=xlValidAlertStop, _
          Operator:=xlBetween, _
          Formula1:=NewFormula1
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Edit I've changed the code after the suggestion from @VBasic2008, thanks for that btw! Now users get error 13 type mismatch at:

Dim NewFormula1 as string: NewFormula1 = "=" & MyRange

for me and others it still works just like before

1 Answers

Update Data Validation When List From Named Range

  • This also illustrates how to reference a worksheet that can be identified only with the fact that a specific one of its workbook's names refers to a range on it.
Sub UpdateDataValidation()

    ' Define constants.
    Const fRow As Long = 1
    Const Col As String = "O"
    Const nmName As String = "ListName"
    Const dCellAddress As string = "G2"

    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
 
    ' Attempt to reference the name ('nm').
    Dim nm As Name
    On Error Resume Next
        Set nm = wb.Names(nmName)
    On Error GoTo 0
    
    ' Validate the name.
    If nm Is Nothing Then
        MsgBox "The name '" & nmName & "' doesn't exist in the workbook '" _
            & wb.Name & "'.", vbCritical
        Exit Sub
    End If
    
    ' Attempt to reference the range the name refers to ('rg').
    Dim rg As Range
    On Error Resume Next
        Set rg = nm.RefersToRange
    On Error GoTo 0
    
    ' Validate the range.
    If rg Is Nothing Then
        MsgBox "The name '" & nmName & "' doesn't refer to a range.", vbCritical
        Exit Sub
    End If
    
    ' Reference the worksheet ('ws') where the range is located.
    Dim ws As Worksheet: Set ws = rg.Worksheet
    
    ' Calculate the last row ('lRow'),
    ' the row of the bottom-most non-empty cell in the column.
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
    
    ' Validate the last row.
    If lRow < fRow Then
        MsgBox "No data in the validation range.", vbCritical
        Exit Sub
    End If
    
    ' Reference the (new) range ('rg').
    Dim rCount As Long: rCount = lRow - fRow + 1
    Set rg = ws.Cells(fRow, Col).Resize(rCount)
    
    ' Update the address of the range where the name refers to.
    With nm
        .RefersTo = "='" & ws.Name & "'!" & rg.Address
        .Comment = "Modified " & CStr(Now)
    End With
    
    ' Store the new formula in a variable ('NewFormula1').
    Dim NewFormula1 As String: NewFormula1 = "=" & nmName
    
    ' Apply data validation.
    With ws.Range(dCellAddress).Validation
        ' Check if the new formula is not equal to the initial formula.
        If StrComp(.Formula1, NewFormula1, vbTextCompare) <> 0 Then ' not equal
            ' Apply data validation.
            .Delete
            .Add _
                Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:=NewFormula1
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        'Else ' the formulas are equal; do nothing
        End If
    End With

End Sub
Related