Substitute parts of Entries by criteria list

Hello Raph,

Are you asking if it is possible to create 2 columns: 1 files that have a matching color code and 1 for those that don't? It is possible to separate the two types.

Hello Raph,

I modified the macro to replace only cells that have matching color codes in column "A". If the there is no color code then file name is unchanged.

Sub ChangeFileNames()
 'Revised to change only file names that have a valid color code in column "A"

  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
            Cell = RegExp.Replace(Cell, "$1~" & ColorCode & "$4")
          End If
        End If
      Next Cell
      
End Sub