Option Explicit
Sub sbFindDuplicatesInColumn_C()
Dim i As Long
'Declaring the lastRow variable as Long to store the last row value in the Column1
Dim lastRow As Long
'matchFoundIndex is to store the match index values of the given value
Dim matchFoundIndex As Long
'iCntr is to loop through all the records in the column 1 using For loop
Dim iCntr As Long
'Finding the last row in the Column 1
lastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Range("A65000").End(xlUp).Row
'looping through the column1
For iCntr = 1 To lastRow
'checking if the cell is having any item, skipping if it is blank.
If Cells(iCntr, 1) <> "" Then
'getting match index number for the value of the cell
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If iCntr <> matchFoundIndex Then
'Printing the label in the column B
Cells(iCntr, 1).Interior.Color = RGB(255, 12, 0)
Cells(iCntr, 2) = "there are duplicates here!"
End If
End If
Next
End Sub
For a path that is for example, 52 characters long the above code highlights duplicates in column 1. But, I have a path that is 611 characters long, and for some reason it does not detect duplicates OR highlights them, instead returns an error message:
Option Explicit
'>>>> this is for a path that is 52 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are detected for this path (in column 1) and removed properly
'Const sPathTop As String = "\\?\C:\Users\abcde\Downloads\downloads abc 123 docs"
'>>>> this is for a path that is 611 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are NOT detected for this path (in column 1) and gives run-time error 13: type mismatch, highlighting "highlighting matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2
Const sPathTop As Variant = "\\?\C:\Users\nrhfy\Downloads\seagate 500\Documents and Settings\abcd\AppData\Local\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Adobe\Acrobat\11.0"
Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8
Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim sParentFolder As Variant
Sub Start()
Dim rowStart As Long
aryExclude = Array("")
Init
rowStart = rowOut
sParentFolder = RemovePrefix(sPathTop)
Call GetFiles(oFSO.GetFolder(sPathTop))
wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
'wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
'wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
'wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""
End Sub
Sub GetFiles(oPath As Object)
Dim oFolder As Object, oSubFolder As Object, oFile As Object
If IsExcluded(oPath) Then Exit Sub ' stops recursion
sParentFolder = IIf(Left(oPath.path, 4) = "\\?\", Right(oPath.path, Len(oPath.path) - 4), oPath.path)
Call ListInfo(oPath, "Subfolder")
For Each oFile In oPath.Files
Call ListInfo(oFile, "File")
Next
For Each oSubFolder In oPath.SubFolders
Call GetFiles(oSubFolder)
Next
End Sub
'============================================================================
Private Sub Init()
Set wsOut = Worksheets("Sheet2")
With wsOut
rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
If rowOut = 1 Then ' blank sheet
.Cells(rowOut, 1).Value = "FILE/FOLDER PATH"
.Cells(rowOut, 2).Value = "PARENT FOLDER"
.Cells(rowOut, 3).Value = "FILE/FOLDER NAME"
.Cells(rowOut, 4).Value = "FILE or FOLDER"
.Cells(rowOut, 5).Value = "DATE CREATED"
.Cells(rowOut, 6).Value = "DATE MODIFIED"
.Cells(rowOut, 7).Value = "SIZE"
.Cells(rowOut, 8).Value = "TYPE"
End If
rowOut = rowOut + 1
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub
' IFolder object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
' Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
' ShortName, ShortPath, Size, SubFolders, Type
' iFile object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
' Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
' Attributes
Private Sub ListInfo(oFolderFile As Object, sType As String)
With oFolderFile
wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.path)
wsOut.Cells(rowOut, colParent).Value = RemovePrefix(Left(.path, Len(.path) - Len(.Name) - 1))
wsOut.Cells(rowOut, colName).Value = .Name
wsOut.Cells(rowOut, colFileFolder).Value = sType
wsOut.Cells(rowOut, colCreated).Value = .DateCreated
wsOut.Cells(rowOut, colModified).Value = .DateLastModified
wsOut.Cells(rowOut, colSize).Value = .Size
wsOut.Cells(rowOut, colType).Value = .Type
End With
rowOut = rowOut + 1
End Sub
Private Function IsExcluded(p As Object) As Boolean
Dim i As Long
IsExcluded = True
For i = LBound(aryExclude) To UBound(aryExclude)
If UCase(p.path) = UCase(aryExclude(i)) Then Exit Function
Next i
IsExcluded = False
End Function
Private Function RemovePrefix(s As String) As String
If Len(s) < 5 Then
RemovePrefix = s
Else
RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
End If
End Function
I am not understanding why it would not highlight because i can list the folders with long folder path recursively without errors and I would think that highlighting doesn't depend on the number of characters in a string...what is the solution to this?
Reply With Quote