Compare files in folder with comments in sheet, rename files based on conditions

I have a folder with txt files and in a sheet I have comments from A1 going down to A...
I would like to compare the txt filenames with the values in the sheet and rename the files per example below.


In the folder, the files are named in various ways, as an example:

Mark; repopulate - export.txt
[came to early] Nick .txt
John - late for work.txt
etc



In a sheet, starting at A1 and going down (A2,A3 A4 etc) I have a list of comments. The important thing about the comments is that
they have a number in front before the comment begins and the number is separated by a space before the actual comment. For example,

1 Mark, repopulate
20 John Late
100 Nick to early
etc


I would like to compare the txt filenames with the comments in the sheet from A1 going down to A..., and when there is a match of most words, add the number in front of the filename of the txt.
So with the above example,

Mark; repopulate - export.txt to be renamed to 1 Mark; repopulate - export.txt
[came to early] Nick.txt to be renamed to 100 [came to early] Nick.txt
John - late for work.txt to be renamed 20 John - late for work.txt

I hope the above makes sense.

Any help is greatly appreciated. Thank you.

Thank you for the reply. How is the folder that contains the txt files selected? I can't figure it out. I get an error on line
Set objFolder = Fso.GetFolder(Path)

I did a quick test and I get lots of duplicates which makes it very difficult to check the results.

By duplicates, I mean that the number prefixed in a lot of the txt files is the same. For example, I get

1 Mark, repopulate (in A1)
1 John Late (in A2)
100 Nick to early (in A3)
etc


The filename of each txt file is unique in the sense that when comparing it with Column A, there will be no "conflict" as to what number needs to be prefixed to the txt file, per the example above.


Also, each number appears one time in the comments in Column A, so it is not possible to appear more than one time when its being prefixed to the txt file.


I hope I am making sense, I'm trying to be clear in my explanation.

Thank you.

I am uploading an example. Assume that you have the following txt files:

Jame - performed very well - was on time.txt
Jane ; Was Sick Today; Came Late.txt
John ; was on time - he was not ok.txt
Mark - Did not come to Work on time .txt
Mark ; changed the time with another person.txt
Mick ; was late for work - he performed well.txt

The files will be renamed to:

6 Jame - performed very well - was on time.txt
3 Jane ; Was Sick Today; Came Late.txt
1 John ; was on time - he was not ok.txt
2 Mark - Did not come to Work on time .txt
4 Mark ; changed the time with another person.txt
5 Mick ; was late for work - he performed well.txt

Comparing the txt filenames and the comments in Column A, which txt file refers to which cell in Column A, is based on matching the most words.
Then extract the number that appears in front of the comment and prefix it in front of the txt filename. There are no repeating numbers in front of each comment in Column A, so similarly
there should be no same number prefixed in front of multiple txt files.

Thank you

I tested it quickly but I get mixed results, especially when there are a lot of txt files compared to only a few.

Just to mention in case the following points affect the results, the number of txt files is only sometimes exactly the same as the comments in Column A. Most times the txt files are less, for example,
there might be 100 txt files but 200 comments.

Also in the txt filenames and in the comments, there are mixed characters except the alphabetical ones (commas, exclamation marks,semicolons, dashes etc).

I will test it more and will get back. Thank you for the reply.

sans,

See if this works.

Sub test()
    Dim myDir As String, fn As String, x
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "*.txt")
    Do While fn <> ""
        x = VLookLike(fn, Sheets(1).Cells(1).CurrentRegion.Columns(1))
        If x <> "" Then Name myDir & fn As myDir & Val(x) & " " & fn
         fn = Dir
    Loop
End Sub

Function VLookLike(txt As String, rng As Range) As String
    Dim i As Long, e, myName As String
    Dim a(), n As Long, x, temp, m As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "^[A-Z][a-z]+"
        If .test(txt) Then
            myName = .Execute(txt)(0)
            For Each e In rng.Columns(1).Value
                .Pattern = "\d+[; -]*" & myName & "[ ;-]*(.+)"
                If .test(e) Then
                    n = n + 1
                    ReDim Preserve a(1 To 2, 1 To n)
                    a(1, n) = e: a(2, n) = 0
                    temp = .Execute(e)(0).submatches(0)
                    .Pattern = " *[;-]+ *"
                    temp = Replace(Application.Trim(.Replace(temp, " ")), " ", "|")
                    .Pattern = "\b(" & temp & ")\b"
                    For Each m In .Execute(txt)
                        a(2, n) = a(2, n) + Len(m)
                    Next
                End If
            Next
        End If
    End With
    If n > 0 Then
        With Application
            x = Application.Max(.Index(a, 2, 0))
            If x > 0 Then VLookLike = a(1, .Match(x, .Index(a, 2, 0), 0))
        End With
    End If
End Function

Thank you jindon for the reply. I tried it but I get no activity (or error). In my testing workbook, the data is in Sheet1, in column A1:A12.

What am I doing wrong?

Running on the test example is no problem and I get correct results. Running it on other files, I get no activity which is very strange.

Originally Posted by sans

Running on the test example is no problem and I get correct results. Running it on other files, I get no activity which is very strange.

Very strange.
If it doesn't work, either your list/file names are different.
See attached, it replicates what it should do in the worksheet.

I tested it on a sample of 100 txt files. For seven files, it didn't prefix the number which is no problem, for the rest of the 93 all were correct. I found what I was doing wrong, it was the formatting of the numbers in column A,
because of the large number of files,to keep a right order, the formatting I have is

001. File1.txt
002. File2.txt
003. File3.txt
etc

I changed the formatting in column A to

1 File1.txt
2 File2.txt
3 File3.txt


and it renamed the txt files without problem. Then I used a renaming utility to format the txt files back to 000 format so I can get them in ascending order, which again is no problem.

It was my fault that I assumed it can be any number formatting as long as its separated by space. If its no problem to get a modification of your code for 000. formatting, it would be great.
If not, again is not an issue. The code works perfect for what I want it to do.

Thank you

Try change to

Sub test()
    Dim myDir As String, fn As String, x
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "*.txt")
    Do While fn <> ""
        x = VLookLike(fn, Sheets(1).Cells(1).CurrentRegion.Columns(1))
        If x <> "" Then Name myDir & fn As myDir & x & " " & fn
         fn = Dir
    Loop
End Sub

Function VLookLike(txt As String, rng As Range) As String
    Dim i As Long, e, myName As String
    Dim a(), n As Long, x, temp, m As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "^[A-Z][a-z]+"
        If .test(txt) Then
            myName = .Execute(txt)(0)
            For Each e In rng.Columns(1).Value
                .Pattern = "(\d+)[; -]*" & myName & "[ ;-]*(.+)"
                If .test(e) Then
                    n = n + 1
                    ReDim Preserve a(1 To 2, 1 To n)
                    a(1, n) = .Execute(e)(0).submatches(0): a(2, n) = 0
                    temp = .Execute(e)(0).submatches(1)
                    .Pattern = " *[;-]+ *"
                    temp = Replace(Application.Trim(.Replace(temp, " ")), " ", "|")
                    .Pattern = "\b(" & temp & ")\b"
                    For Each m In .Execute(txt)
                        a(2, n) = a(2, n) + Len(m)
                    Next
                End If
            Next
        End If
    End With
    If n > 0 Then
        With Application
            x = Application.Max(.Index(a, 2, 0))
            If x > 0 Then VLookLike = a(1, .Match(x, .Index(a, 2, 0), 0))
        End With
    End If
End Function

That's perfect! Exactly what I needed. Thank you for the continuous help