Need to create a long substitute/replace list

[sam5500]

I have been ripping my movie collection now for a little and need a little help with a database I am creating for it. I have a movie database list with the movie titles in column C, the year in column D, and the release version (Theatrical Cut, Director's Cut, etc) in column E. I currently have column B setup to substitute symbols with "."

The current formula is as follows in column B:
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(C3," - ",".")," ","."),"'",""),":",""),"/","."),"..",""),",","")&IF(RIGHT(C3,1)=".","",".")&D3&IF(E3="","","."&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(E3," - ",".")," ","."),"'",""),":",""),"/","."),"..",""),",",""))
The problem I am running into is that you can only nest 7 Substitutes before it no longer will work and I need to substitute many more symbols than that.

I want the output in column B to be as follows where each word and the year is separated by only one ".":

[TABLE="width: 833"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]B[/TD]
[TD]C [/TD]
[TD]D[/TD]
[TD]E [/TD]
[/TR]
[TR]
[TD]Info File Filename[/TD]
[TD]Title[/TD]
[TD]Year[/TD]
[TD]Release Version[/TD]
[/TR]
[TR]
[TD]Movie.1.Title.2016.Directors.Cut[/TD]
[TD]Movie 1 Title[/TD]
[TD]2016[/TD]
[TD]Director's Cut[/TD]
[/TR]
[TR]
[TD]Movie.2.Title.2012.Recut.Unrated.Extended[/TD]
[TD]Movie 2: Title[/TD]
[TD]2012[/TD]
[TD]Recut, Unrated, Extended[/TD]
[/TR]
[TR]
[TD]Movie.3.Title.2010[/TD]
[TD]Movie 3 - Title[/TD]
[TD]2010[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Movie.3.Title.A.Title.B.2004[/TD]
[TD]Movie 3 Title A/Title B[/TD]
[TD]2004[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Movie.5.Title.2005.Special.Edition.DVD[/TD]
[TD]Movie 5... Title[/TD]
[TD]2005[/TD]
[TD]Special Edition DVD[/TD]
[/TR]
</tbody>[/TABLE]

I have setup a new sheet named "Replacement List" where the value to be replaced is in column A and the new symbol is in column B as follows:
[TABLE="width: 198"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Find…[/TD]
[TD]Replace With…[/TD]
[/TR]
[TR]
[TD]" - "[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"-"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"?"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"/"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]""[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"'"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]": "[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"_"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"|"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"("[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]")"[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]","[/TD]
[TD]"."[/TD]
[/TR]
[TR]
[TD]"$"[/TD]
[TD]"."[/TD]
[/TR]
</tbody>[/TABLE]

How would I best go about this?

Keep in mind that "Movie-1" and "Movie - 1" would both need to return "Movie.1". "Movie - 1" should NOT return "Movie...1".

 

[sam5500]

I don't know how to edit a post since I just joined, but I forgot to mention that if there's something like a "?" on the end then it shouldn't return anything. For example, "Movie 1?" should still return "Movie.1"

I know this might be too complicated and I might just be better off manually entering everything, but getting this somewhat automated would be greatly appreciated! Thanks!

 

[sam5500]

Bump. Anyone have at least a start to this?

 

[Perpa]

Bump. Anyone have at least a start to this?

Sam,
Give this bit of code a try...
Perpa

Sub Repl_Chrs()
Dim rnge As Range
Dim n As Integer
Dim lc As Long
Dim SpecialConcat As String

LastRow = Range("C65536").End(xlUp).Row
For n = 2 To LastRow
    Cells(n, "C") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "C"), "/", "."), " - ", ""), "... ", ".")
    Cells(n, "D") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "D"), "/", "."), " - ", "."), "... ", ".")
    Cells(n, "E") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "E"), "/", "."), " - ", "."), "... ", ".")
    
    Cells(n, "C") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "C"), ", ", "."), ": ", "."), " ", ".")
    Cells(n, "D") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "D"), ", ", "."), ": ", "."), " ", ".")
    Cells(n, "E") = Application.Substitute(Application.Substitute(Application.Substitute(Cells(n, "E"), ", ", "."), ": ", "."), " ", ".")
        For lc = 3 To 5
            SpecialConcat = SpecialConcat & Cells(n, lc) & "."
        Next lc
    
    Cells(n, "B") = SpecialConcat
    SpecialConcat = ""
Next n
End Sub

 

[mikerickson]

I would use a UDF instead of the built in SUBSTITUTE

Function ReplacePunctuationWith(aString as String, replacement_Character as String, optional PunctuationMarks as String = "/-_&?[]{}<>(),$") As String
    Dim i As long
    ReplacePunctuaionWith = aString
    For i = 0 to Len(PunctuationMarks)
        ReplacePunctuationWith = Replace(ReplacePunctuationWith, Mid(PuncutationMarks,i,1), replacement_Character)
    Next i
End Function

Then your formula would become ReplacePunctuationWith(C3&"."&D3&"."&E3, ".")


If I missed some characters from your list you could either alter the list of default punctuation marks in the UDF or pass them as an argument.

 

[Perpa]

I would use a UDF instead of the built in SUBSTITUTE
QUOTE]

Mike,
Thanks for the insight...I tried using the Function and the following code and got an error on the line in red. Not sure what this means.
The error stated: "Runtime error '5', Invalid Proceedure call or argument". Probably has to do with the 'cells(n,"?")' format I used.
Any suggestions?
Perpa

Sub Mike1()
Dim n As Integer
LastRow = Range("C65536").End(xlUp).Row
For n = 2 To LastRow
Cells(n, "B") = ReplacePunctuationWith(Cells(n, "C") & "." & Cells(n, "D") & "." & Cells(n, "E"), ".")
Next n
End Sub

Function ReplacePunctuationWith(aString As String, replacement_Character As String, Optional PunctuationMarks As String = "/-_&?[]{}<>():,$") As String
    Dim i As Long
    ReplacePunctuaionWith = aString
    For i = 0 To Len(PunctuationMarks)
        [COLOR=#ff0000]ReplacePunctuationWith = Replace(ReplacePunctuationWith, Mid(PuncutationMarks, i, 1), replacement_Character)[/COLOR]
    Next i
End Function