Trouble with Matching Algorithm

[exce_lapprentice]

Hi Everyone,

I'm trying to write a matching algorithm to compare text & number from two different worksheets. The first will have one row of information, which I have stored in a dictionary object, and the second will have many rows, which I will look through with the for loops. If all the columns in a row match, I want to copy the data into a third worksheet. I have worked through most of the errors and typos, but I still don't get any results when I run the program. Any suggestions?

Thanks,
M

' Subroutine to compare startup data with vc database, and generate review page' Called from 'Match' button on 'Startup-Data tab
Sub MatchStartup()


    ' Disable UI updates
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Prep config
    Call Config.Prep
    
    ' Store startup page information
    Set dataSheet = Sheets("Startup-Data")


    ' Setup dictionary for startup data
    Dim i As Integer
    Dim targetRow As Integer
    Dim firstname As String
    Dim lastname As String
    Dim company As String
    Dim website As String
    Dim email As String
    Dim checksize As Double
    Dim amountraised As Double
    Dim revenue As Double
    Dim reffirm As String
    Dim stage As String
    Dim dev As String
    Dim location As String
    Dim filter As Integer
    Dim industry As String
    
    Set StartupData = New Dictionary
    
    more = True
    i = 6
    
    ' Transfer startup data to new dictionary
    While more
        Set firstnameCell = dataSheet.Cells.Find("FIRST_NAME").Offset(1, 0)
        firstname = firstnameCell.Value
        Set lastnameCell = dataSheet.Cells.Find("LAST_NAME").Offset(1, 0)
        lastname = lastnameCell.Value
        Set companyCell = dataSheet.Cells.Find("COMPANY").Offset(1, 0)
        company = companyCell.Value
        Set websiteCell = dataSheet.Cells.Find("WEBSITE").Offset(1, 0)
        website = websiteCell.Value
        Set emailCell = dataSheet.Cells.Find("E-MAIL").Offset(1, 0)
        email = emailCell.Value
        Set checksizeCell = dataSheet.Cells.Find("CHECK SIZE").Offset(1, 0)
        checksize = checksizeCell.Value
        Set stageCell = dataSheet.Cells.Find("STAGE").Offset(1, 0)
        stage = stageCell.Value
        Set amountraisedCell = dataSheet.Cells.Find("AMOUNT RAISED TO DATE").Offset(1, 0)
        amountraised = amountraisedCell.Value
        Set revenueCell = dataSheet.Cells.Find("REVENUE").Offset(1, 0)
        revenue = revenueCell.Value
        Set reffirmCell = dataSheet.Cells.Find("REFERRING FIRM").Offset(1, 0)
        reffirm = reffirmCell.Value
        Set industryCell = dataSheet.Cells.Find("INDUSTRY").Offset(1, 0)
        industry = industryCell.Value
        Set locationCell = dataSheet.Cells.Find("LOCATION").Offset(1, 0)
        location = locationCell.Value
        Set filterCell = dataSheet.Cells.Find("FILTER").Offset(1, 0)
        filter = filterCell.Value
        'Set devCell = dataSheet.Cells.Find("DEVELOPMENT STAGE").Offset(1, 0)
        'dev = devCell.Value
        
        i = i + 1
        
        If Len(Worksheets("Startup-Data").Cells(i, 4)) = 0 Then more = False
    Wend
    
    ' delete matching data from matching review page
    Worksheets("Matching Review").Activate
    Last = Cells(Rows.count, "B").End(xlUp).Row
    For i = Last To 2 Step -1
        If (Cells(i, "B").Value) = "VC" Then
            Cells(i, "B").EntireRow.ClearContents
        End If
    Next i
    
   
    Set dataSheet = Sheets("VC-Data")
    
    ' Create data table region and loop through data rows
    Dim srcRegion As Range, srcRowRel As Integer
    Set srcRegion = Cells.Find("CONTACT_OWNER").CurrentRegion
    hdrRow = srcRegion.Row
    hdrCol = srcRegion.Column
    Dim hdr As String
    ' create match counter
    Dim matchcounter As Integer
    matchcounter = 0
    ' Loop through data rows
    For r = 2 To srcRegion.Rows.count
        srcRow = hdrRow + r - 1
        srcRowRel = r - 1
        ' First pass: compare column entries with startup-data dictionary
        For col = 2 To srcRegion.Columns.count
            srcCol = hdrCol + c - 1
            ' Look for header name
            hdr = Cells(hdrRow, srcCol).Value
            ' Compare startup's referring firm with vc firm name
            If hdr = "FIRM" And Cells(srcRow, srcCol).Value <> StartupData.Item(reffirm) Then
                ' keep record of category matches
                matchcounter = matchcounter + 1
            End If
            ' compare VC's minimum check size with startup's round size
            If hdr = CHECK_SIZE And Cells(srcRow, srcCol).Value <= StartupData.Item(checksize) Then
                 matchcounter = matchcounter + 1
            End If
            If hdr = "AMOUNT RAISED TO DATE" And Cells(srcRow, srcCol).Value <= StartupData.Item(amountraised) Then
                matchcounter = matchcounter + 1
            End If
            If hdr = "REVENUE" And Cells(srcRos, srcCol).Value <= StartupData.Item(revenue) Then
                matchcounter = matchcounter + 1
            End If
            If hdr = "STAGE" Then
                Dim stagecounter As Integer
                stagecounter = 0
                Dim stagetxt As String
                Dim stage_x As Variant
                Dim stage_i As Long
                stagetxt = Cells(srcRow, srcCol).Value
                stage_x = Split(stagetxt, ",")
                For stage_i = 0 To UBound(stage_x)
                    If Split(stage_i) = StartupData.Item(stage) Then
                        stagecounter = stagecounter + 1
                    End If
                Next stage_i
                If stagecounter <> 0 Then
                   matchcounter = matchcounter + 1
                End If
            End If
            If hdr = "DEVELOPMENT STAGE" Then
                Dim devcounter As Integer
                devcounter = 0
                Dim devtxt As String
                Dim dev_x As Variant
                Dim dev_i As Long
                devtxt = Cells(srcRow, srcCol).Value
                dev_x = Split(devtxt, ",")
                For dev_i = 0 To UBound(dev_x)
                    If Split(dev_i) = StartupData.Item(devstage) Then
                        devcounter = devcounter + 1
                    End If
                Next dev_i
                If devcounter <> 0 Then
                    matchcounter = matchcounter + 1
                End If
            End If
            If hdr = "LOCATION" Then
                Dim loccounter As Integer
                loccounter = 0
                Dim loctxt As String
                Dim loc_x As Variant
                Dim loc_i As Long
                loctxt = Cells(srcRow, srcCol).Value
                loc_x = Split(loctxt, ",")
                For loc_i = 0 To UBound(loc_x)
                    If loc_x(loc_i) = "US" Then
                        loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = "Mid-Atlantic" And (StartupData.Item(location) = "New Jersey" Or "New York" Or "Pennsylvania") Then
                            loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = "Northeast" And (StartupData.Item(location) = "Connecticut" Or "Maine" Or "Massachusetts" Or "New Hampshire" Or "Rhode Island" Or "Vermont") Then
                            loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = "Midwest" And (StartupData.Item(location) = "Illinois" Or "Indiana" Or "Iowa" Or "Kansas" Or "Michigan" Or "Minnesota" Or "Missouri" Or "Nebraska" Or "North Dakota" Or "Ohio" Or "South Dakota" Or "Wisconsin") Then
                            loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = "South" And (StartupData.Item(location) = "Alabama" Or "Arkansas" Or "Delaware" Or "Florida" Or "Georgia" Or "Kentucky" Or "Louisiana" Or "Maryland" Or "Mississippi" Or "North Carolina" Or "Oklahoma" Or "South Carolina" Or "Tennessee" Or "Texas" Or "Virginia" Or "Washington DC" Or "West Virginia") Then
                            loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = "West" And (StartupData.Item(location) = "Alaska" Or "Arizona" Or "California - North" Or "California - South" Or "Colorado" Or "Hawaii" Or "Idaho" Or "Montana" Or "Nevada" Or "New Mexico" Or "Oregon" Or "Utah" Or "Washington" Or "Wyoming") Then
                            loccounter = loccounter + 1
                    ElseIf loc_x(loc_i) = StartupData.Item(location) Then
                        loccounter = loccounter + 1
                    End If
                Next loc_i
                If loccounter <> 0 Then
                    matchcounter = matchcounter + 1
                End If
            End If
            If hdr = "INDUSTRY" Then
                Dim indcounter As Integer
                indcounter = 0
                Dim indtxt1 As String
                Dim indtxt2 As String
                Dim ind_x As Variant
                Dim ind_y As Variant
                Dim ind_i As Long
                Dim ind_j As Long
                indtxt1 = Cells(srcRow, srcCol).Value
                indtxt2 = StartupData.Item(industry)
                ind_x = Split(indtxt1, ",")
                ind_y = Split(indtxt2, ",")
                For ind_i = 0 To UBound(x)
                    For ind_j = 0 To UBound(y)
                        If ind_y(ind_j) = ind_x(ind_i) Then
                            indcounter = indcounter + 1
                        End If
                    Next ind_j
                Next ind_i
                If indcounter <> 0 Then
                    matchcounter = matchcounter + 1
                End If
            End If
            If hdr = "FILTER" Then
                If Cells(srcRow, srcCol).Value = 1 And StartupData.Item(filter) = 1 Then
                    matchingcounter = matchingcounter + 1
                ElseIf Cells(srcRow, srcCol).Value = 2 And (StartupData.Item(filter) = 1 Or 2) Then
                    matchingcounter = matchingcounter + 1
                ElseIf Cells(srcRow, srcCol).Value = 3 Then
                    matchingcounter = matchingcounter + 1
                End If
            End If
        Next col
        ' Get destination table on match review page
        Dim dstRegion As Range, dstRow As Integer
        dstRow = dstRegion.Row + dstRegion.Rows.count
        ' On the second pass - if there is a match - copy the data from this row
        If matchingcounter >= 9 Then
            For d = 2 To srcRegion.Columns.count
                srcCol = hdrCol + c - 1
                ' match header to destination table
                hdr = Cells(hdrRow, srcCol).Value
                Set dstHdr = Sheets("Matching Review").Cells.Find(hdr)
                ' copy data for this row and column
                If Not dstHdr Is Nothing Then
                    dstCol = dstHdr.Column
                    Set dstCell = Sheets("Matching Review").Cells(dstRow, dstCol)
                    dstCell.Value = Cells(srcRow, srcCol).Value
                End If
            Next d
            ' On the third pass fill in default and startup
            For f = 2 To dstRegion.Columns.count
                col = dstRegion.Column + f - 1
                hdr = Sheets("Matching Review").Cells(dstRow, col)
                ' make sure first column is empty
                If StrComp(hdr, "Interested in Meeting? Y/N") <> 0 Then
                    cell.Value = 0
                End If
                ' for all empty cells where a default value exists
                If IsEmpty(cell) And MatchingReviewDefaults.Exists(hdr) Then
                    ' Get default value
                    cell.Value = MatchingReviewDefaults(hdr)
                End If
            Next f
        End If
    Next r


' Re-enable UI
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

 

[ChrisM]

That's a LOT of code to take in and try to reason through! I only made it through the first few sections so these may not be 100% of the issues....

Two things I see in this area:

' Transfer startup data to new dictionary
    While more
        Set firstnameCell = dataSheet.Cells.Find("FIRST_NAME").Offset(1, 0)
        firstname = firstnameCell.Value
        Set lastnameCell = dataSheet.Cells.Find("LAST_NAME").Offset(1, 0)
...
...
...
...

First, you are looping until i equals a certain value. I get that, but every time you loop, you are executing the EXACT same searches (per the two sample lines above). So if i has to get to 100, you've just searched the same 100 cells over and over. Seems like you need to have i somewhere in the sample lines above? Or, keep the .FIND searches outside of your while loop.

Second, the heading of this section mentions transferring data to the dictionary, but no where do I see any add code that ADDs items to the dictionary. Later on you test for items, but I don't see you adding any.

I'm actually not sure why you need a dictionary object, if you have 10 columns in your data sheet, then just store those 10 values in either 10 variables or one array(1 to 10), then, loop through your search rows, and for each row, check the 10 cells one by one for a match.

Or, depending on the type of data you have in the 10 cells, just smash them all together by concatenating (yourstring = A1 & B1 & C1 & etc), then compare the two strings against each other for an exact match.

I'm not quite sure what you are doing with all the "hdr" testing, but you should explore using a SELECT CASE statement for that section, it will help to make cleaner code.

 

[exce_lapprentice]

That's a LOT of code to take in and try to reason through! I only made it through the first few sections so these may not be 100% of the issues....

Two things I see in this area:

' Transfer startup data to new dictionary
    While more
        Set firstnameCell = dataSheet.Cells.Find("FIRST_NAME").Offset(1, 0)
        firstname = firstnameCell.Value
        Set lastnameCell = dataSheet.Cells.Find("LAST_NAME").Offset(1, 0)
...
...
...
...

First, you are looping until i equals a certain value. I get that, but every time you loop, you are executing the EXACT same searches (per the two sample lines above). So if i has to get to 100, you've just searched the same 100 cells over and over. Seems like you need to have i somewhere in the sample lines above? Or, keep the .FIND searches outside of your while loop.

Second, the heading of this section mentions transferring data to the dictionary, but no where do I see any add code that ADDs items to the dictionary. Later on you test for items, but I don't see you adding any.

I'm actually not sure why you need a dictionary object, if you have 10 columns in your data sheet, then just store those 10 values in either 10 variables or one array(1 to 10), then, loop through your search rows, and for each row, check the 10 cells one by one for a match.

Or, depending on the type of data you have in the 10 cells, just smash them all together by concatenating (yourstring = A1 & B1 & C1 & etc), then compare the two strings against each other for an exact match.

I'm not quite sure what you are doing with all the "hdr" testing, but you should explore using a SELECT CASE statement for that section, it will help to make cleaner code.

Thank you for the tips. You're right, I don't really need a dictionary and my search code doesn't actually need to be a loop, but I do want to be able to set conditions for each comparison. For example check size in the initial row of data must be greater than the check size column in the larger database for the match to go through. And each comparison is in a different category, with a specific condition - depending on the header - so I was trying to search for each header in order to prevent errors if the data columns were rearranged further down the line.

 

[ChrisM]

Ok, again without going through all the code, if you've decided not to use a dictionary, you ARE using it your comparisons, so I assume they will all fail:

If hdr = "FIRM" And Cells(srcRow, srcCol).Value <> StartupData.Item(reffirm) Then

I think you should replace StartupData.Item(reffirm) with reffirm
and do that for all the search terms