Search code examples
vbaexcelduplicatesworksheet-function

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

  • 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