Moving file to folder with first couple matching characters

Hello everyone,

I'm wanting to use VBA to save some time in moving some files around. Basically, I have a list of word documents that are datasheets that are formatted as an an equipment piece name following a unique number, ie.

13-215.1 - Pump, Syringe 123456.docx. Id like to move these documents into their respective folders with the "UNIQUEIDENTIFIER - EQUIPMENT NAME" folder ie. 13-215.1 - Pump, Syringe folder. So I have already created all the folder names and the issue is the folder names are not always exactly matching the folder names, but the unique identifiers are, so id like to move the documents to the folders based on their number code. So: ME-102 - Cabinet, Biosafety, 6 ft 234567.docx ids moved to ME-102 - Cabinet, Biosafety, 6 ft folder 18-430.1 - Imaging Device, X-Ray Unit, Rad, Digital -TRANSFER.docx is moved to 18-430.1 - Imaging Device, X-Ray Unit, Rad, Digital folder **notice that the documents names include numbers/notes that are not included in the folder name** So my thought is that maybe we can move document to folder with when the first 8 characters of the folder name and the document name are matching? Anyone worked on something like this before? Thank you in advance for any help - this would save me a looooot of time :)

Welcome to VBAX Jess98. Perhaps a more detailed explanation is required here. You indicated;
1. a "List of word documents", where currently is the list situated?
2. "already created all the folder names", is there a parent folder name?

Do any of the files with the last piece (234567.docx) have spaces?

i.e.

ME-102 - Cabinet, Biosafety, 6 ft 2345 67.docx --> \ME-102 - Cabinet, Biosafety, 6 ft

Otherwise, you can just Split() the file name and build the new path

Code:

---

Option Explicit

'ME-102 - Cabinet, Biosafety, 6 ft 234567.docx ids moved to ME-102 - Cabinet, Biosafety, 6 ft folder
'18-430.1 - Imaging Device, X-Ray Unit, Rad, Digital -TRANSFER.docx is moved to 18-430.1 - Imaging Device, X-Ray Unit, Rad, Digital folder


Sub MoveFiles()
    Dim sFile1 As String, sFile2 As String, sPath1 As String, sPath2 As String
    Dim v As Variant
    Dim i As Long
   
   
    'inputs
    sPath1 = "d:\Test"
    sPath2 = "d:\Test1\"
   
    sFile1 = "ME-102 - Cabinet, Biosafety, 6 ft 234567.docx"
   
    'get rid of last part
    v = Split(sFile1, " ")
   
    For i = LBound(v) To UBound(v) - 1
        sFile2 = sFile2 & v(i) & " "
    Next i


    sFile2 = Left(sFile2, Len(sFile2) - 1)
     
    Name (sPath1 & "\" & sFile1) As sPath2 & sFile2 & "\" & sFile1
End Sub

---

No error checking and no folder creation

The work to loop the file list, etc. is left as an assignment for the reader