How to detect pipe-separated date elements that are duplicates before saving them via a Userform because they already exist in an Excel table?

Question

I have a userform that captures multiple dates formatted to be saved in a single row from a table as follows:

Dates Stored
|10-sep||11-sep||12-sep||14-sep||17-sep|
|19-sep||23-sep||27-sep|
|12-sep||30-sep|

When the user hits the button Save, the userform stores the following data submitted by the user: What I need is that when the user saves the dates, it first detects if one (or several) of the dates already exist in the table. If so, the new record should be saved in the column table "Dates stored" but the "Review" message will appear in the next column named "Comments", both in the new record and in the table row where the duplicate date was detected.

I want each date of the new record being saved from the Userform to be checked against each date of each row in the table.

Ouput result:

Dates Stored	Comments
|10-sep||11-sep||12-sep||14-sep||17-sep|	Review
|19-sep||23-sep||27-sep|
|12-sep||30-sep|	Review

Note that the dates "|12-sep|" in row 1 and "|12-sep|" in row 3 are duplicated.

I have tried without success the duplicate detection methods separating by delimiter and then iterating over each date comparing the dates saved in the table with the ones the user is entering. (VBA dictionaries and arrays)

Any help will be welcome.

Answer 1

The Dictionary object is employed to maintain a list of dates with concatenated row numbers as their corresponding values.

Option Explicit
Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, j As Long, sCmt As String
    Dim arrData, arrRes, sKey, arrKey
    Dim oSht As Worksheet
    Set objDic = CreateObject("scripting.dictionary")
    Set oSht = Sheets("Sheet3") ' Update as needed
    ' Loading table
    Set rngData = oSht.Range("A1").CurrentRegion
    arrData = rngData.Value
    ' Dict key: date string
    ' Dict value: concatenated row numbers
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = Mid(arrData(i, 1), 2, Len(arrData(i, 1)) - 2)
        arrKey = Split(sKey, "||")
        For j = LBound(arrKey) To UBound(arrKey)
            sKey = arrKey(j)
            If objDic.exists(sKey) Then
                objDic(sKey) = objDic(sKey) & "," & i
            Else
                objDic(sKey) = i
            End If
        Next j
    Next i
    Dim inputText As String
    inputText = "|12-sep||30-sep|" ' Test 1
'    inputText = "|01-sep||02-sep|" ' Test 2
'    inputText = "|01-sep||27-sep|" ' Test 3
    sCmt = ""
    sKey = Mid(inputText, 2, Len(inputText) - 2)
    arrKey = Split(sKey, "||")
    ' Check the existance of date string
    For j = LBound(arrKey) To UBound(arrKey)
        If objDic.exists(arrKey(j)) Then
            arrRes = Split(objDic(arrKey(j)), ",")
            For i = LBound(arrRes) To UBound(arrRes)
                arrData(arrRes(i), 2) = "Review"
            Next i
            sCmt = "Review"
        End If
    Next
    ' Write upated table
    rngData.Value = arrData
    ' Write new recorde
    With oSht.Cells(oSht.Rows.Count, 1).End(xlUp).Offset(1, 0)
        .Value = inputText
        .Offset(0, 1).Value = sCmt
    End With
    Set objDic = Nothing
End Sub