Excel - VBA : deal with elements of an array when looking for matches

Question

I am working on a program whose purpose is to identify parts of an address in a database. The input is a column, each cell containing one word / number from the address. On the other hand, in the database, each cell contains a complete information of a few words.

Here is an example :

Here is what I'm already doing :
1/ Looping in database column (here from G3 to G7) and activate the current cell.
2/ For each cell of (B2:B9), look for a match with the ActiveCell
3/ If a match is found, add 10 points to a cell, when the loop in column B is finished, skip to another cell from database. So in this example, there would be 3 matches in G3, so 30 points.

It's ok but I want to make it more accurate by taking into account the position of words "General Finance Tower" would be spotted as matching the database.

To do so, I plan to split the content of the cells in G in an array.

Here is the way it would be improved :
1/ Looping in database column from G2:G7. Split the first cell in an array of n words (3 in this case): " General / Finance / Tower"
2/ Look for a match between the first word of the array and elements from column B. If no, match, skip to the next element (B2, B3, ... B9). If still no match after B9, then skip to the second element of the array (Finance) and keep going.
If match (here between "General" (first element of the array) and B2) Then look if there is a match between the next element of the array and the next element of the column B ("Finance" and "Finance"). If yes, do it again ("Tower" and "Tower") and so on.

This way, "General Finance" would be spotted, and then "General Finance Tower", giving more accuracy to my program.

Here is my question, more related to programming:

I know how to split G columns into arrays, but i don't know how to navigate in it. If instead of an array it was N different cells, I would start to cell 1, activate it and then use an offset(1,0) to go to the next cell, offset(2,0) to go two cells further, and so on, looking for matches in every cases. How to do so with when using an array? How to go to the next element?

 stringData = Split(ActiveCell.Value, " ")  
 For i = LBound(stringData) To UBound(stringData)
 If Match(ActiveCell, stringData(i)) Then ...
 else  
 End If
 Next i 

This would allow me from the first element to the last but wouldn't really offer me options to navigate (for example, looking for a match directly with the second element if the current element is matching).

Thanks in advance for your suggestion, it would really help!

Answer 1

um yeah so I wrote the code for you that will score based on my understanding of your problem complexity. The input and output look like this:

and the code ...
x) has sooo many comments you should be able to modify it easily in case something is not right.

Option Explicit

Sub DatabaseVsInputComparison_Scoring()

    Dim ws              As Worksheet    ' worksheet instance
    Dim i&, j&, k&, x   As Long         ' iterators
    Dim db_startRow     As Long         ' -->
    Dim db_startColumn  As Long         ' -->  These variables will
    Dim db_lastRow      As Long         ' -->  store the database table
    Dim db_lastColumn   As Long         ' -->  boundries
    Dim inp_startRow    As Long         ' starting row of the data in INPUT column
    Dim inp_lastRow     As Long         ' last row in the INPUT column
    Dim inp_column      As Long         ' the column number of the INPUT column
    Dim rng             As Range        ' active db range reference
    Dim inp_rng         As Range        ' active input ref
    Dim score           As Long         ' store temporary score

    ' // setters
    Set ws = Sheets("Sheet1")           ' set reference
    db_startRow = 3                     ' set starting row for the database data
    db_startColumn = 7                  ' set starting column for the database data
    inp_startRow = 2                    ' set starting row of the data in input column
    inp_column = 2                      ' set starting row for the input column

    ' // getters
    ' get the boundries of the database table
    db_lastRow = ws.Cells(Rows.Count, db_startColumn).End(xlUp).Row
    db_lastColumn = ws.Cells(db_startRow, Columns.Count).End(xlToLeft).Column
    inp_lastRow = ws.Cells(Rows.Count, inp_column).End(xlUp).Row

    ' iterate through the database table
    For i = db_startRow To db_lastRow ' each ROW
        For j = db_startColumn To db_lastColumn ' each COLUMN
            score = 0 ' reset the score for each cell in the database set
            Set rng = ws.Cells(i, j)
            Dim splitted ' array storing each word of the "active" cell
            splitted = Split(rng.Value, " ")
            If UBound(splitted) > -1 Then
                For k = inp_startRow To inp_lastRow ' each input column data cell
                    Set inp_rng = ws.Cells(k, inp_column)
                    ' check if the first word has got a match in the input column
                    If StrComp(CStr(splitted(0)), inp_rng.Value, 1) = 0 Then

                        score = 12 ' set initial score

                        ' this is where you want to iterate through the rest of the active database cell
                        '   and check if the next words match, right?
                        For x = 1 To UBound(splitted)
                            ' now youre checking the next word in the splitted array
                            '   against the next word in the input column
                            If StrComp(CStr(splitted(x)), inp_rng.Offset(x, 0).Value, 1) = 0 Then
                                ' if the match is found you want to keep on checking
                                ' and incrementing the score
                                score = score + 12

                            ' if no match you want to exit the loop
                            ' > no extra score
                            Else
                                Exit For
                            End If
                        Next x

                    End If
                    Set inp_rng = Nothing
                Next k
                ' score calculation
                ' if max score reached then add extra 3 to the score
                If score = ((UBound(splitted) + 1) * 12) Then score = score + 3
                rng.Offset(0, 5).Value = score
                Set rng = Nothing
            End If
        Next j
    Next i

End Sub