I'm actually building a Database in Excel, where sheets are tables, columns are columns, and row are records, kinda simple for the moment.

I made a function that return a boolean if a record with Value1 and Value2 are already registered on the same Row, to prevent duplicate.

Here's the problem I'm facing : I'm actually doing the same Function for 3 values matching

There must be a way to make it dynamicaly depending on numbers of value from an array. But i'm just stuck on it.

There is my initial code for 2 Values matching

Function checkDuplicate(ws As Worksheet, value1 As Variant, value2 As Variant) As Boolean
    Dim rng As Range
    Dim first As Variant
    
    checkDuplicate= False
    
    If (ws.Name <> "UI" And ws.Name <> "Lists") Then
    
        With ws.Range("A:A")
            Set rng = .Find(value1)
            
            If Not rng Is Nothing Then
                first = rng.Row
                Do
                    If ws.Range("B" & rng.Row).Value = value2 Then
                        checkDuplicate= True
                    End If
                    Set rng = .FindNext(rng)
                Loop While rng.Row <> first
            End If
        End With
    End If
End Function

I apologize in case my english is kinda bad, or in case someone already helped another person for the same problem because I didn't find it when I searched.

Any help would be highly appreciated.

CodePudding user response：

If you are building a database then consider using SQL

Option Explicit

Sub test()
    MsgBox checkDuplicate(Sheet1, Array(1, "ABC", "2021-01-12"))
End Sub

Function checkDuplicate(ws As Worksheet, ar As Variant) As Boolean
    Dim cn As Object, cmd As Object, rs As Object
    Dim sql As String, arWhere() As String, i As Long
    
    ReDim arWhere(UBound(ar))
    For i = 0 To UBound(ar)
       arWhere(i) = "[" & ws.Cells(1, i   1) & "] = ?" '
    Next
   
    sql = " SELECT COUNT(*) FROM [" & ws.Name & "$] " & _
          " WHERE " & Join(arWhere, " AND ")
    Debug.Print sql
          
     'Connecting to the Data Source
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
        "Extended Properties=""Excel 12.0 XML;HDR=YES"";"
        .Open
    End With

    Set cmd = CreateObject("ADODB.Command")    
    With cmd
        .ActiveConnection = cn
        .CommandText = sql
        For i = 0 To UBound(ar)
            .Parameters.Append .CreateParameter(CStr(i), 12, 1) ' adVariant
        Next
        Set rs = .Execute(, ar)
    End With
    checkDuplicate = rs(0) > 0
    cn.Close
    
End Function

CodePudding user response：

thanks for your answer

I already think about building a database with SQL, sadly this do not really match to my needs because datas I'm storing has almost no "logical link" and are really disparate.

Nevermind I figured out but i'm feeling like this piece of code isn't really clean if someone knows how to improve it, feel free to answer !

Function checkDuplicate(ws As Worksheet, valuesArray As Variant) As Boolean
    Dim rng As Range
    Dim first As Variant
    Dim i As Long, j As Long
    Dim elements As Long
    checkDuplicate = False
    
    elements = UBound(valuesArray) - LBound(valuesArray)   1
    
    If (ws.Name <> "Interface" And ws.Name <> "Listes") Then
    
        With ws.Range("A:A")
            Set rng = .Find(valuesArray(0))
            
            If Not rng Is Nothing Then
                first = rng.Row
                Do
                    i = 1
                    j = 1
                    
                    Do
                        If ws.Cells(i   1, rng.Row).Value = valuesArray(i) Then
                             i = i   1
                        Else
                             j = j   1
                        End If
                    Loop Until i = elements Or j = elements
                    
                    If i = elements Then
                        checkDuplicate = True
                        GoTo leave
                    End If
                    
                    Set rng = .FindNext(rng)
                Loop While rng.Row <> first
            End If
        End With
    End If
leave:
End Function