VBA_change array to Range

[SP321]

Hi,

can anyone please update the code below? It is for dropdown menu, which cannot be overwritten with copy+paste.
This works perfectly, but sometimes the list is too long (over 255 characters) and once I close and open the file it is showing errors. I found the solution and it needs to be done through a range.

No matter how I try to change the code I get Syntax errors. Since I am complete beginner I can't figure out how to refer to a list in name manager.
Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim isect As Range

Dim cell As Range

Dim dd As Variant

Dim i As Long

Dim mtch As Boolean

Dim msg As String

Dim myEntries As String

Set isect = Intersect(Range("B7:B600"), Target)

If Not isect Is Nothing Then

Application.EnableEvents = False

dd = Array("A", "B", "C", "D", "")

For Each cell In isect

mtch = False

For i = LBound(dd) To UBound(dd)

If cell.Value = dd(i) Then

mtch = True

Exit For

End If

Next i

If mtch = False Then

cell.ClearContents

msg = msg & cell.Address(0, 0) & ","

End If

Next cell

For i = LBound(dd) To UBound(dd)

myEntries = myEntries & dd(i) & ","

Next i

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

With Range("B7:B600").Validation

.Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries

' .IgnoreBlank = True

' .InCellDropdown = True

' .InputTitle = ""

' .ErrorTitle = ""

' .InputMessage = ""

' .ErrorMessage = ""

' .ShowInput = True

' .ShowError = True

End With

If Len(msg) > 0 Then

MsgBox "Invalid data in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "Error"

End If

End If

Application.EnableEvents = True

End Sub

Can anyone please help? Thank you very much.

 

[James006]

Just tested the macro below with no problem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim c As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String

Set isect = Intersect(Range("B7:B600"), Target)
If isect Is Nothing Then Exit Sub

        Application.EnableEvents = False
        dd = Array("A", "B", "C", "D", "")
            For Each c In isect
              mtch = False
                For i = LBound(dd) To UBound(dd)
                    If c.Value = dd(i) Then
                        mtch = True
                        Exit For
                    End If
                Next i
            
                If mtch = False Then
                    c.ClearContents
                    msg = msg & c.Address(0, 0) & ","
                End If
            Next c
        For i = LBound(dd) To UBound(dd)
            myEntries = myEntries & dd(i) & ","
        Next i
        
        myEntries = Left(myEntries, Len(myEntries) - 1)
        
            With Range("B7:B600").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=myEntries
            End With
        
        If Len(msg) > 0 Then
            MsgBox "Invalid data in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "Error"
        End If

    Application.EnableEvents = True

End Sub

 

[SP321]

Just tested the macro below with no problem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim c As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String

Set isect = Intersect(Range("B7:B600"), Target)
If isect Is Nothing Then Exit Sub

        Application.EnableEvents = False
        dd = Array("A", "B", "C", "D", "")
            For Each c In isect
              mtch = False
                For i = LBound(dd) To UBound(dd)
                    If c.Value = dd(i) Then
                        mtch = True
                        Exit For
                    End If
                Next i
           
                If mtch = False Then
                    c.ClearContents
                    msg = msg & c.Address(0, 0) & ","
                End If
            Next c
        For i = LBound(dd) To UBound(dd)
            myEntries = myEntries & dd(i) & ","
        Next i
       
        myEntries = Left(myEntries, Len(myEntries) - 1)
       
            With Range("B7:B600").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=myEntries
            End With
       
        If Len(msg) > 0 Then
            MsgBox "Invalid data in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "Error"
        End If

    Application.EnableEvents = True

End Sub

Hi, yes this code works fine, but I have e.g. countries for dropdown list which exceeds 255 characters, then it doesn't work. I would like to replace dd=array with range, but no matter what I do I get syntax errors

 

[James006]

OK ...
Most probably your actual validation list of countries is readily available and has a Name visible in the Name Manager (Ctrl+F3) ....
So you could use in your code Range("MyList") ....

 

[SP321]

OK ...
Most probably your actual validation list of countries is readily available and has a Name visible in the Name Manager (Ctrl+F3) ....
So you could use in your code Range("MyList") ....

yes it is in name manager, if it is not too much bother could you please show me how the code would look? maybe I find the mistake I make

 

[James006]

Since you are using MyEntries for your Validation, you could test:
Dim MyEntries As Range
Set MyEntries = Range("MyList")

 

[SP321]

Since you are using MyEntries for your Validation, you could test:
Dim MyEntries As Range
Set MyEntries = Range("MyList")

it doesn't work for me but as I said Im really bad, so I think Im making mistake somewhere

 

[James006]

OK ...
Below is your test Event macro for a starting point

Private Sub Worksheet_Change(ByVal Target As Range)
' Adds in the Range B7:B600 a Data Validation built with
' your List defined with the Named Range myEntries

If Intersect(Range("B7:B600"), Target) Is Nothing Then Exit Sub
    Application.EnableEvents = False
            With Range("B7:B600").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=myEntries"
            End With
    Application.EnableEvents = True
End Sub

Hope this will help

 

[James006]

Hello,

Sorry, but I forgot to mention that, for your Data Validation to be working effectively, you do need, beforehand, to add a Named Range within your worksheet, for your list of countries, and you do need to give it the same Name as the one you are using in your macro .... in this case myEntries

Hope this clarifies

 

[SP321]

Hello,

Sorry, but I forgot to mention that, for your Data Validation to be working effectively, you do need, beforehand, to add a Named Range within your worksheet, for your list of countries, and you do need to give it the same Name as the one you are using in your macro .... in this case myEntries

Hope this clarifies

Hi yes, I figured that one out, thank you :D
This works good, now I'm trying to mix it with the full code to also forbid pasting wrong data