How to eliminate a row with a "file directory" for a parameter of hour - excel

Question

I have rows in excel with a file structure for example.
Row 1 c:\User\Folder100\13-25\File100.log
Row 2 c:\User\Folder200\11-16\File200.log
Row 3 c:\User\Folder300\21-20\File300.log
Row 4 c:\User\Folder400\13-25\File400.log
Row 5 c:\User\Folder400\9-10\File400.log
Row 6 c:\User\Folder500\8-16\File500.log
Row 7 c:\User\Folder600\8-16\File600.log
Row 8 c:\User\Folder700\11-16\File700.log
Row 9 c:\User\Folder700\9-40\File700.log
With the first rows there aren't any problem because the file logs are different but with the rows (4 and 5) a There are the same log in two different folders "c:\User\Folder400\13-25\" and c:\User\Folder400\9-10\ I would like to keep just 13-25(eliminate Row 5) because has more recent time.
Also with the lines 8 and 9 I just want to keep row 8 (11-16)
Row 1 c:\User\Folder100\13-25\File100.log
Row 2 c:\User\Folder200\11-16\File200.log
Row 3 c:\User\Folder300\21-20\File300.log
Row 4 c:\User\Folder400\13-25\File400.log
Row 6 c:\User\Folder500\8-16\File500.log
Row 7 c:\User\Folder600\8-16\File600.log
Row 8 c:\User\Folder700\11-16\File700.log
(eliminated row 5 and 9)
Do you know any Idea how to made it in VBA¿?

Answer 1

The code below
uses a RegEx to extract the folder name and file number into two new columns (see pic below)
sorts the columns by column B and then by column C descending
delete the entire row where duplicate exists in column B using Excels Remove Duplicates functionality (the latest time comes first in column CV so it is preserved)
Removes the two working columns
Update: The code below assumes that both the 1st folder after "User" and the file name much match for it to be a duplicate - the initial guidelines are still ambigious. This code does solve the example shown in the question
Sub Sliced()
Dim lngRow As Long
Dim lngCalc As Long
Dim objReg As Object
Dim objDic As Object
Dim rng1 As Range
Dim X()
Dim Y()
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
'See Patrick Matthews excellent article on using Regular Expressions with VBA
Set objReg = CreateObject("vbscript.regexp")
objReg.Pattern = "(.+\\){2}(.+\\)(\d+)\-\d+\\(.+)"
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
X = rng1.Value2
Y = X
For lngRow = 1 To UBound(X)
'replace the leading zeroes
X(lngRow, 1) = objReg.Replace(X(lngRow, 1), "$2$4")
Y(lngRow, 1) = objReg.Replace(Y(lngRow, 1), "$3")
Next
Columns("B:C").Insert
rng1.Offset(0, 1) = X
rng1.Offset(0, 2) = Y
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rng1.Offset(0, 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rng1.Offset(0, 2), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SetRange rng1.Cells(1).Offset(0, 1).Resize(rng1.Rows.Count, 2)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.UsedRange.RemoveDuplicates Columns:=2, Header:=xlNo
Columns("B:C").Delete
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
Set objReg = Nothing
End Sub

Answer 2

This does not exactly serve the purpose, but serves to illustrate a way by which you could go about problems like this.
It takes into account the filename and the time string preceding it only. The folder can be added if necessary.
Main Module:
Option Explicit
Private dict As dictionary
'Prints the rows you need (time criterion applied)
Private Sub FindDuplicates()
Dim lastRow As Long, row As Long
Dim x As Variant, v As Variant
Dim fileName As String, timeString As String
Set dict = CreateObject("Scripting.Dictionary")
'Determine last row
lastRow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).row
'Iterate and store in dictionary
For row = 1 To lastRow
x = Split(Cells(row, 1), Application.PathSeparator)
fileName = x(UBound(x))
timeString = x(UBound(x) - 1)
AddDictEntry fileName, row, timeString
Next row
'Print results
For Each v In dict.Keys
Debug.Print "FileName: " & v & ", Recent Version: " & dict.Item(v)
Next
End Sub
To add/remove dictionary entries:
Private Sub AddDictEntry(fileName As String, rowNo As Long, timeString As String)
Dim timeParts As Variant, timeLong As Long
'converts time string to long, for comparison
timeParts = Split(timeString, "-")
timeLong = CInt(timeParts(0)) * 100 + CInt(timeParts(1))
'Adds entry to dictionary if time is more recent
If (dict.Exists(fileName)) Then
If CInt(dict.Item(fileName)) < timeLong Then
dict(fileName) = timeLong
End If
Else
dict.Add fileName, timeLong
End If
End Sub
Input:
c:\User\Folder100\13-25\File100.log
c:\User\Folder200\11-16\File200.log
c:\User\Folder300\21-20\File300.log
c:\User\Folder400\13-25\File400.log
c:\User\Folder400\9-10\File400.log
c:\User\Folder300\22-20\File300.log
Output:
FileName: File100.log, Recent Version: 1325
FileName: File200.log, Recent Version: 1116
FileName: File300.log, Recent Version: 2220
FileName: File400.log, Recent Version: 1325