Hello Raph81,
This macro has been added to the attached workbook. All file names that have a matching color code are placed in column "B" of the "Filenames" worksheet.
Sub ChangeFileNames()
Dim Cell As Range
Dim ColorCode As String
Dim DSO As Object
Dim R As Long
Dim RegExp As Object
Dim Rng As Range
Dim RngEnd As Range
Dim Wks As Worksheet
Set DSO = CreateObject("Scripting.Dictionary")
DSO.CompareMode = vbTextCompare
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = "(.+)(\_)(\w{3})(\..+)"
Set Wks = Worksheets("ColorCodes")
Set Rng = Wks.Range("A1")
Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = Wks.Range(Rng, RngEnd)
For Each Cell In Rng
Key = Trim(Cell.Text)
If Key <> "" Then
If Not DSO.Exists(Key) Then DSO.Add Key, Cell.Offset(0, 1).Text
End If
Next Cell
Set Wks = Worksheets("Filenames")
Set Rng = Wks.Range("A1")
Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = Wks.Range(Rng, RngEnd)
For Each Cell In Rng
If RegExp.Test(Cell) = True Then
ColorCode = DSO(RegExp.Replace(Cell, "$3"))
If ColorCode <> "" Then
R = R + 1
Wks.Cells(R, "B") = RegExp.Replace(Cell, "$1~" & ColorCode & "$4")
End If
End If
Next Cell
End Sub
Bookmarks