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  
etc.

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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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.
0
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.



»bp
0
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, "__", "_")
Loop

MsgBox strTemp
End Sub

Open in new window

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

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
0
Martin LissOlder 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, "__", "_")
    Loop
Next

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, "__", "_")
    Loop
Next

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Fabrice LambertFabrice 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:
=mergeUnderscores(A1)

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.
0
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.
0
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
0
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

0
Andreas HermleTeam leaderAuthor Commented:
Hi Fabrice,

ok, thank you very much for your help :-)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.