'Excel VBA code error type mismatch using worksheetfunction to find duplicates

I get a

Type Mismatch Error "13"

with the below code. Can anyone assist with where I'm going wrong with my VBA syntax and use of variables.

If Application.WorksheetFuntion.CountIf(Target, r.Value) > 1 Then

I've tried the matchFoundIndex code method to no success...Likely due to incorrect VBA syntax.

The intent of the CountIf line is to look for duplicates in column A. The rest of the code loops through files and worksheets copying the file name, worksheet name, and cell C1 for further analysis. I am a novice at coding and I'm sure there may be Dimmed variables that I'm not using, other formatting, and errors that I have not found yet. Any Help would be appreciative.

Sub CopyFileAndStudyName()

Dim sPath As String, SName As String
Dim xlWB As Workbook
Dim sh As Worksheet
Dim lngRow As Long
Dim lngwsh As Long
Dim xlApp As Excel.Application
Dim sfile As String
Dim wbk As Workbook
Dim iCntr As Long
Dim matchFoundIndex As Long
Dim FindDuplicates As Boolean
Dim IsDup As Boolean

sPath = "C:\Users\mypath\"

' which row to begin writing to in the activesheet
lngRow = 2

SName = Dir(sPath & "*.xlsx") ' for xl2007 & "*.xls"
Set xlApp = New Excel.Application
xlApp.Visible = False

If MsgBox("Are you sure you want to copy all the file and Cell C1 in " & sPath & "?", vbYesNo) = vbNo Then Exit Sub

Do While SName <> ""
    lngwsh = 1
    ' Will cycle through all .xlsx files in sPath
    Set xlWB = xlApp.Workbooks.Open(sPath & SName, , True) ' opens in read-only mode
    ' Will cycle through first 3 of the worksheets in each file copying file name and cell C1 in columns C and D
        For lngwsh = 1 To 3
            Set sh = ActiveSheet
            sh.Cells(lngRow, "A") = xlWB.Name
            sh.Cells(lngRow, "B") = xlWB.Worksheets(lngwsh).Range("C1")
            sh.Cells(lngRow, "C") = xlWB.Sheets(lngwsh).Name

            Dim Target As Range
            Dim r As Range
            Dim lastRow As Long
            Dim ws As Worksheet

            Set ws = xlWB.Worksheets(lngwsh)

            With ws
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                Set Target = ws.Range("A1:A" & lastRow)
            End With
                For Each r In Target
                        If r.Value <> "" Then
                            If Application.WorksheetFunction.CountIf(Target, r.Value) > 1 Then
                                FindDuplicates = True
                                Exit For
                            Else
                                FindDuplicates = False
                            End If
                        End If
                Next r

            Debug.Print FindDuplicates

            IsDup = FindDuplicates

            sh.Cells(lngRow, "D") = IsDup
            FindDuplicates = False

               End If
 lngRow = lngRow + 1
 Next lngwsh

 xlWB.Close False
 xlApp.Quit
 SName = Dir()
 Loop
 MsgBox "Report Ready!"
 End Sub


Solution 1:[1]

If you want to check for Duplicates in a Range, you can use a Dictionary object.

Dim Dict As Object

Set Dict = CreateObject("Scripting.Dictionary")

For Each r In Target
    If Trim(r.Value) <> "" Then
        If Not Dict.exists(r.Value) Then  ' not found in dictionary >> add Key
            Dict.Add r.Value, r.Value
            FindDuplicates = False               
        Else ' found in Dictionary >> Exit
            FindDuplicates = True
            Exit For
         nd If
    End If
Next r

Solution 2:[2]

Sub CopyFileAndStudyName()

Dim sPath As String, SName As String
Dim xlWB As Workbook
Dim sh As Worksheet
Dim lngRow As Long
Dim lngwsh As Long
Dim xlApp As Excel.Application
Dim sfile As String
Dim wbk As Workbook
Dim iCntr As Long
Dim matchFoundIndex As Long
Dim FindDuplicates As Boolean
Dim IsDup As Boolean

sPath = "C:\Users\mypath\"

' which row to begin writing to in the activesheet
lngRow = 2

SName = Dir(sPath & "*.xlsx") ' for xl2007 & "*.xls"
Set xlApp = New Excel.Application
xlApp.Visible = False

If MsgBox("Are you sure you want to copy all the file and Cell C1 in " & sPath & "?", vbYesNo) = vbNo Then Exit Sub

Do While SName <> ""
lngwsh = 1
' Will cycle through all .xlsx files in sPath
Set xlWB = xlApp.Workbooks.Open(sPath & SName, , True) ' opens in read-only mode
' Will cycle through first 3 of the worksheets in each file copying file name and cell C1 in columns C and D

     For lngwsh = 1 To 3
        Set sh = ActiveSheet
        sh.Cells(lngRow, "A") = xlWB.Name
        sh.Cells(lngRow, "B") = xlWB.Worksheets(lngwsh).Range("C1")
        sh.Cells(lngRow, "C") = xlWB.Sheets(lngwsh).Name

        Dim Target As Range
        Dim r As Range
        Dim lastRow As Long
        Dim ws As Worksheet

        Set ws = xlWB.Worksheets(lngwsh)

        With ws
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            Set Target = ws.Range("A1:A" & lastRow)
        End With
            For Each r In Target
                    If r.Value <> "" Then
                        If Application.WorksheetFunction.CountIf(Target, r.Value) > 1 Then
                            FindDuplicates = True
                            Exit For
                        Else
                            FindDuplicates = False
                        End If


                    End If
            Next r

        Debug.Print FindDuplicates

        IsDup = FindDuplicates

        sh.Cells(lngRow, "D") = IsDup
        FindDuplicates = False


lngRow = lngRow + 1
Next lngwsh
xlWB.Close False
xlApp.Quit
SName = Dir()
Loop
MsgBox "Report Ready!"
End Sub

Solution 3:[3]

I was having a similar experience using CountIF and passing it a range. In my case I was using:

i = Application.WorksheetFunction.CountIf(ws.UsedRange, r.Value)

which was giving me a Type Mismatch error. I had seen other people having success with the first parameter wrapped in Range() so after a few tries I found out that this would work:

i = Application.WorksheetFunction.CountIf(Range(ws.UsedRange.Address), r.Value)

So, I suggest that you change your code to this and see if it works:

If Application.WorksheetFuntion.CountIf(Range(Target.Address), r.Value) > 1 Then

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Shai Rado
Solution 2 Mina Saad
Solution 3 Ben