VBA: type mismatch error on finding elements from another list - excel

Question

i am working on the exercise below but i need some help. It is giving runtime error 13. I am a beginner, can you please help me solve it? Of course other ways of solving the problem are more than welcomed. There are 2 lists (1: Sheet2.Range("E5:E1324") and 2:SearchRange = Sheet1.Range("F2:F4178"))
, of long text format and not exact match, list 1 contains a phrase of the information in list2. I need to know how many times data in list 2 is mentioned in list 1 (as i know there are times it goes up to 7)
Thank you a lot,
Ana
Sub countvalues()
' count how many times data in Description Range is listed in SearchRange
Dim i As Integer 'for looping in Description
Dim j As Integer 'for looping in SearchRange
Dim Counter As Integer
Dim FoundData As Range
Dim Description As Range
Dim SearchRange As Range
Set Description = Sheet2.Range("E5:E1324")
Set SearchRange = Sheet1.Range("F2:F4178")
Application.ScreenUpdating = False
Counter = 0
For i = 5 To 1324 'trying with a narrower range for testing purpose
For j = 2 To 4178
Set FoundData = SearchRange.Find(Sheet2.Range("E" & i))
'On Error Resume Next
Counter = FoundData.Count + 1
Next j
Sheet2.Range("F" & i) = Counter
Next i
Application.ScreenUpdating = True
End Sub

Answer 1

Try the adapted code, please. It will work only if your string used for search (What) is contained in the searched range cells... I mean "test searched" will be found in "test searched today". But "test searched today" will not be found in "test searched"
Sub testFindSimilar()
Dim d As Long, strFirstAddress As String
Dim Counter As Long, lastR1 As Long, lastR2 As Long
Dim shD As Worksheet, shS As Worksheet, cel As Range
Set shD = sheet1
Set shS = sheet2
lastR1 = shS.Range("F" & Rows.Count).End(xlUp).Row
lastR2 = shD.Range("E" & Rows.Count).End(xlUp).Row
For d = 5 To lastR2
Set cel = shS.Range("F2:F" & lastR1).Find(What:=shD.Range("E" & d).value, _
After:=shS.Range("F2"), LookIn:=xlValues, SearchOrder:=xlByRows, LookAt:=xlPart)
If Not cel Is Nothing Then
strFirstAddress = cel.Address
Do
Set cel = shS.Range("F2:F" & lastR1).FindNext(cel)
If Not cel Is Nothing Then
Counter = Counter + 1
End If
Loop Until cel.Address = strFirstAddress
End If
shD.Range("F" & d).value = Counter
Counter = 0: strFirstAddress = ""
Next d
End Sub
If you wont to test less rows, you can replace last rows variable with your testing numbers.