[FUNCTION] FindSimilarValues(table, field, compare_value, delimiter, match_per_cent) (1 Viewer)

[BlueIshDan]

FindSimilarValues(table_name, field_name, compare_value, delimiter, match_per_cent) As String()​

This function will return an array of strings representing the values within a table's field that contained 0-100% of the passed string.

For Example:​

Table: tblMaster
Field: ProjectName
Field Values:
- 1 test 3 4 5 6 7 8 9 10
- 1 test 3 4 5 6 7 test 9 10
- 1 2 3 4 5 test 7 8 9 10
- test test test test test test test test test test
- 1 2 test 4 5 test 7 8 test 10
- 1 2 test 4 5 6 7 8 9 10
- 1 test 3 4 test 6 7 test 9 10
- 1 2 test 4 5 6 7 8 9 10
- 1 2 3 4 5 6 7 test 9 10
- 1 2 3 4 5 test 7 8 9 test

Function: FindSimilarValues("tblMaster", "ProjectName", "test", " ", 30)

Results:
- test test test test test test test test test test
- 1 2 test 4 5 test 7 8 test 10
- 1 test 3 4 test 6 7 test 9 10

Example Use​

    Dim msg As String
    For Each var_project_name In FindSimilarValues("tblMaster", "ProjectName", "test", " ", 30)
        msg = msg & var_project_name & vbNewLine
    Next
    MsgBox msg

Function​

Private Function FindSimilarValues(ByVal table_name As String, _
                                    ByVal field_name As String, _
                                    ByVal compare_value As String, _
                                    ByVal delimiter As String, _
                                    ByVal match_per_cent As Integer) As String()
    
    Dim results() As String
    Dim results_count As Long: results_count = -1
    Dim rs As Recordset: Set rs = CurrentDb.OpenRecordset(table_name)
    
    Dim matches As Integer
    Dim rs_word_count As Integer
    
    
    With rs
        While Not .EOF
        
            matches = 0
            rs_word_count = 0
            
            For Each var_rs_split In Split(.Fields(field_name), delimiter)
            
                rs_word_count = rs_word_count + 1
                
                For Each var_split In Split(compare_value, delimiter)
                
                    If var_rs_split = var_split Then
                    
                        matches = matches + 1
                        Exit For
                        
                    End If
                    
                Next
                
            Next
            
            If matches >= (rs_word_count * (match_per_cent / 100)) Then
                results_count = results_count + 1
                ReDim Preserve results(results_count)
                results(results_count) = .Fields(field_name)
            End If
            
            .MoveNext
        Wend
        
    End With
    
    FindSimilarValues = results
        
End Function

Regards,
BlueIshDan