Compare array from cell to list of country codes-CodePudding

My current cell input for a range of cells is country codes as follows eg. NL - UK - FR - BR

I have a list with country codes and I'm trying to check every time a cell has changed if it only contains country codes from the list with separator in-between.

I have the following code thanks to the advice from Tim:

Sub ProcessThree(Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
'1. replace the wrong seperators
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " / ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " . ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " , ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " : ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " ; ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace "  ", " - "
'symbols entered without space
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace "/", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ".", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ",", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ":", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ";", " - "



'2. Split cell based on seperator
Dim arr() As String
arr = Split(Target, " - ")
Dim countrycode As Variant
For Each countrycode In arr
MsgBox countrycode
Next


End Sub

For the moment stuck on the match part.

I have two questions. Is it not possible to show an entire array outside of the for each when I get the message box for for example ER - DE => it shows the message box twice for each country code - is that normal? and does anyone have a good example on how to match an array with a list/range of country codes? Thanks in advance, already a lot further then when I started.

CodePudding user response：

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const THE_RANGE = "B199:B218,B223:B242,B247:B261,B266:B275"
    Const SEP As String = "-"
    
    Dim c As Range, arr, s As String, e, v, rngList As Range, msg As String
    
    If Target.Cells.Count > 1 Then Exit Sub 'single-cell updates only
    
    'is the change in the range of interest?
    Set c = Application.Intersect(Target, Me.Range(THE_RANGE))
    If c Is Nothing Then Exit Sub 'no intersect
    
    v = Trim(UCase(c.Value))      'trim and upper-case the user-entered value
    If Len(v) = 0 Then Exit Sub   'no content
    
    'normalize to wanted separator
    For Each e In Array("/", ".", ",", ":", ";", " ")
        v = Replace(v, e, SEP)
    Next e
    
    Set rngList = ThisWorkbook.Sheets("Lists").Range("A1:A20") 'for example
    arr = Split(v, SEP)
    
    For Each e In arr
        e = Trim(e)
        If Len(e) > 0 Then
            'is this code in the list
            If IsError(Application.Match(e, rngList, 0)) Then
                msg = msg & IIf(Len(msg) > 0, vbLf, "") & e 'add to error message
            Else
                'don't add items already added
                If Instr(SEP & s & SEP, e) = 0 Then
                    s = s & IIf(Len(s) > 0, SEP, "") & e  'goes back into cell...
                End If
            End If
        End If
    Next e
    Application.EnableEvents = False  'don't re-trigger the event...
    Target.Value = s
    Application.EnableEvents = True
    
    'any codes removed?
    If Len(msg) > 0 Then
        MsgBox "The following country codes are not valid:" & vbLf & msg, vbExclamation
    End If
End Sub