Multiple consecutive occurrences of underscore character must be replaced with just one

Dear Experts:

I got hundreds of file names where I should eleminate any consecutive use of the underscore character, ...

i.e. multiple consecutive occurrences of the underscore character should be replaced by just one underscore character, such as

Before                                                                             After
MyProduct__134_final____file.xls                                  MyProduct_134_final_file.xls
My_Products__4_finalfile_file__latest.xls                    My_Products_4_finalfile_file_latest.xls  

Can this be done using a formula or do I need a VBA solution.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?
Martin LissConnect With a Mentor Older than dirtCommented:
If you are physically selecting certain cells then run this version after selecting them.

Sub StripUnderscores()

Dim cel As Range

For Each cel In Selection
    Do While InStr(1, cel.Value, "__") > 0
        cel.Value = Replace(cel.Value, "__", "_")

End Sub

Open in new window

If they are in a particular column then no need to select them. Just use this version.

Sub StripUnderscores()

Dim lngLastRow As Long
Dim lngRow As Long
Const COL = "A" ' Change to match your data column

lngLastRow = Range(COL & "1048576").End(xlUp).Row

For lngRow = 1 To lngLastRow
    Do While InStr(1, Cells(lngRow, COL).Value, "__") > 0
        Cells(lngRow, COL).Value = Replace(Cells(lngRow, COL).Value, "__", "_")

End Sub

Open in new window

Rob HensonFinance AnalystCommented:
You wouldn't be able to do it with a formula but would certainly be able to use VBA.

A VBA script could be setup to open each file and then save as a new name without the repeated underscores.

I could do the file save as new name bit but there is no doubt a better VBA expert that would be able to trawl through a specific folder doing each one.

Alternatively, there might be an option for a VB Script ie not Excel specific that can do it within Explorer. I have added this as a topic for you.
Bill PrewCommented:
Just pick up any one of the handful of freeware file rename utilities.  I've used this one with good success, lots of options for interesting renames, but easily handles basic ones like this also.

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Martin LissOlder than dirtCommented:
Here is a macro that will do it for a single file. To do multiple files you would need to change line 5 into some type of loop. If you need help in doing that then let me know if you get the names directly from your computer or if they are in a worksheet.

Sub StripUnderscores()

Dim strTemp As String

strTemp = "MyProduct__134_final____file.xls"

Do While InStr(1, strTemp, "__") > 0
    strTemp = Replace(strTemp, "__", "_")

MsgBox strTemp
End Sub

Open in new window

Andreas HermleTeam leaderAuthor Commented:
Rob and Bill, thank you very much for your swift help. Uppps, I should have been more precise. I am not talking about filenames being changed in Windows Explorer. These filenames are strings within cells.  Sorry, this was my fault.

So Martin's approach is the right one. Martin, actually I need more help with this macro. Actually I would prefer running the macro on consecutively selected cells, if possible.  Hope this is feasible.

I am off to run some errands now. I will check on posts later tonight. Thank you very much for your great help.

Regards, Andreas
Fabrice LambertConnect With a Mentor Fabrice LambertCommented:
This can be done easilly with a regex:
Public Function mergeUnderscores(ByVal value As String) As String
    Dim rx As Object    '// VBScript_RegExp_55.RegExp
    Set rx = CreateObject("VBScript.RegExp")
    rx.Global = True
    rx.Pattern = "_{2,}"
    mergeUnderscores = rx.Replace(value, "_")
    Set rx = Nothing
End Function

Open in new window

As for calling the function, you can call it as a formula:

I do not recommend looping trough the Selection object, as it is a chaotic object who's value and type depend on user actions.
As a developper (experienced or not) you don't want to use chaotic objects.
Same goes for "Active object" such as ActiveWorkbook, ActiveSheet, ActiveCell, the global Workbooks, Sheets, Range and Cells collections.
Andreas HermleTeam leaderAuthor Commented:
Dear both, great job from both of you, both solutions are just working fine.

Fabrice, I know I shouldn't use the selection object but for some specific reason I was explicitly asking for it.
Martin LissOlder than dirtCommented:
You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
Fabrice LambertFabrice LambertCommented:
Fabrice, I know I shouldn't use the selection object but for some specific reason I was explicitly asking for it
Then, you should check that it is the correct type (a range in your case)
If (TypeOf Selection Is Excel.Range) Then
    '// Ok, Selection is a range
End If

Open in new window

Andreas HermleTeam leaderAuthor Commented:
Hi Fabrice,

ok, thank you very much for your help :-)
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.