Поиск дубликатов и помещение их в мастер-папку

Question

Мой код переименовывает папки на основе того, что находится в первом столбце:

Dim sFolder As String

Option Explicit
Sub addPrefix()
Dim strfile As String
Dim filenum As String

Dim strOldDirName
Dim strNewDirName

strfile = Dir(sFolder)
Dim old_name, new_name As String




    Dim i As Long
    With ThisWorkbook.Worksheets("data")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row

   strOldDirName = sFolder & ThisWorkbook.Worksheets("data").Cells(i, 2).Value
strNewDirName = sFolder & ThisWorkbook.Worksheets("data").Cells(i, 1).Value & " " & ThisWorkbook.Worksheets("data").Cells(i, 2).Value
Name strOldDirName As strNewDirName

        Next i
    End With
End Sub

, а затем я проверяю наличие дубликатов в столбце C (столбец электронной почты). Если они являются дубликатами, я перемещаю их в их «главную» папку (которая является только первой из найденных дубликатов). После этого он добавляет суффикс «- MASTER» к папке.

Вот код для перемещения дубликатов:

    Sub moveDuplicates()
' This will find duplicates and move them into a master folder. It'll will then delete the row

Dim masterID
Dim masterPlatform
Dim objFileSystem

Dim FromPath As String
Dim ToPath As String


Set objFileSystem = CreateObject("Scripting.FileSystemObject")


Dim masterOldFolderName
Dim masterNewFolderName


Dim masterSuffix


Dim LastRow As Long, i As Long
Dim rngWhole As Range, rngSplit As Range


masterID = 0
masterPlatform = 0

masterSuffix = " - MASTER"

masterOldFolderName = ""
masterNewFolderName = ""

With ThisWorkbook.Worksheets("data")

LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

Set rngWhole = .Range("C1:C" & LastRow)
.Range("E" & 1).Value = rngWhole
For i = 1 To LastRow

If WorksheetFunction.CountIf(rngWhole, .Range("C" & i).Value) > 1 Then

Set rngSplit = .Range("C1:C" & i)

If WorksheetFunction.CountIf(rngSplit, .Range("C" & i).Value) = 1 Then

    masterID = .Range("B" & i).Value
    masterPlatform = .Range("A" & i).Value


            '' Renme master folders with subfix of "- MASTER"
            masterOldFolderName = sFolder & masterPlatform & " " & masterID
            masterNewFolderName = sFolder & masterPlatform & " " & masterID & masterSuffix
            Name masterOldFolderName As masterNewFolderName
            '' End of renaming


'.Range("D" & i).Value = "MASTER " & masterID

Else
'.Range("D" & i).Value = "CHILD " & masterID & " This folder: " & .Range("B" & i).Value



'MOVING FOLDER
    FromPath = sFolder & .Range("A" & i).Value & " " & .Range("B" & i).Value '<< Change
    ToPath = sFolder & masterPlatform & " " & masterID & masterSuffix & "\"  '<< needs the slash to go into the folder

    .Range("H" & i).Value = "From: " & FromPath
    .Range("I" & i).Value = "From: " & ToPath


    'Check if source and target folder exists
    If objFileSystem.FolderExists(FromPath) = True And objFileSystem.FolderExists(ToPath) = True Then
        objFileSystem.MoveFolder Source:=FromPath, Destination:=ToPath
        lblStatus.Caption = "Moving " & FromPath & " To " & ToPath




        Rows(i).EntireRow.Delete
        lblStatus.Caption = " Deleting " & .Range("A" & i).Value & " " & .Range("B" & i).Value
        'MsgBox "Source folder has moved to target folder"
    Else
        'MsgBox "Either source or target folder does not exist"
    End If

    ' END OF MOVING FOLDER

' ROW GETS DELETED


End If

'.Range("C" & i).Interior.ColorIndex = 3


End If

Next i

End With


End Sub

Мой сценарий работает в определенной степени:

Но он просто помещает все в первую папку «MASTER»

Вот мой лист:

Затем я вызываю это с кнопки:

    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1) & "\"
        End If
    End With

    If sFolder <> "" Then ' if a file was chosen
        Me.txtFolderPath.Text = sFolder

        '' calls functions
        addPrefix
        moveDuplicates
        Sheet_SaveAs ' saves output
end sub

Это причина, по которой это не так? работает как ожидалось из-за того, что я называю это неправильно?

Полный код: https://www.dropbox.com/s/k06b5hydc4v7bpn/so-files.zip?dl=0

(код можно запустить из девелопера> формы> userform1)

ОТЛАДКА :

Я думаю, что проблема возникает здесь при отладке:

    '' Renme master folders with subfix of "- MASTER"
    masterOldFolderName = sFolder & masterPlatform & " " & masterID
    masterNewFolderName = sFolder & masterPlatform & " " & masterID & masterSuffix
    Name masterOldFolderName As masterNewFolderName
    '' End of renaming

Я не уверен, что это потому, что это не в том месте (что я предполагаю)