Having Trouble with a Matching Algorithm

[exce_lapprentice]

I'm trying to write a program that will match rows of data from 2 different worksheets and then print any matches that may occur in a 3rd worksheet. I have stored the data from the first worksheet, which will only be one row, in a dictionary and then I activate the second worksheet - "VC-Data" - which holds many rows of data. I want my program to go through each row, compare each column to the previously created dictionary, and then copy the data if there is a match.

I have worked out some of the errors, but I'm still not seeing any matches. Any ideas on how I can fix/improve my code?

Thanks,
M

Here's my code:

' 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
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