delete some portion of the 'text to display' for selected hyperlinks

Andreas Hermle
Andreas Hermle used Ask the Experts™
Dear Experts:

On the current worksheet I got hundreds of hyperlinks

The text to display of these hyperlinks are as follows:

Examples:
90-344-75-10_REV_1
90-422-93-22_REV_4
90-375-44-11_REV_6
90-437-22-13
90-169-58-10
90-432-74_10_REV_4

So some of them may have the '_REV_X' missing.

For the selected cells I would like to run a macro that eliminates this part (i.e. the '_REV_X' part) and just leaves the number as 'text to display'.

In the above example after running the macro the 'text to display'' for these hyperlinks would look like as follows:

90-344-75-10
90-422-93-22
90-375-44-11
90-437-22-13
90-169-58-10
90-432-74_10


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

Regards, Andreas
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Try

Sub Macro1()
    Dim cel As Range
    Dim dt As String
    For Each cel In Selection
        If cel.Hyperlinks.Count > 0 Then
        dt = cel.Hyperlinks(1).TextToDisplay
            If InStr(dt, "REV") > 0 Then
                cel.Hyperlinks(1).TextToDisplay = Left(dt, InStr(dt, "REV") - 1)
            End If
        End If
    Next cel
End Sub
Andreas HermleTeam leader

Author

Commented:
Hi Saqib, great, works like a charm. Thank you very much for it.

I only did a minor tweaking, i.e. on line ' cel.Hyperlinks(1).TextToDisplay = Left(dt, InStr(dt, "REV") - 1)' I changed -1 to -2

Great job. Thank you very much for it.
Andreas HermleTeam leader

Author

Commented:
Great job as always, Saqib, Thank you very much
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
This should also work...

Sub DeleteSubString()
Dim Rng As Range
Dim cel As Range

Application.ScreenUpdating = False

Set Rng = Selection

For Each cel In Rng
    If InStr(cel.Value, "_REV") > 0 And cel.Hyperlinks.Count Then
        cel.Value = WorksheetFunction.Replace(cel.Value, InStr(cel.Value, "_REV"), Len(cel.Value), "")
    End If
Next cel

Application.ScreenUpdating = True
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial