Macros from this Forum will not run.

[gmaxey]

Sub Delete_Underlines()
'A basic Word macro coded by Graham Mayor,
   'adapted by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/4/2018
Dim oRng As Range
Dim oScope As Range
  Set oRng = Selection.Range
  Set oScope = oRng.Duplicate
  With oRng.Find
    .ClearFormatting
    .Font.Underline = wdUnderlineSingle
    .Replacement.ClearFormatting
    Do While .Execute()
      If oRng.InRange(oScope) Then
      If oRng.Hyperlinks.Count = 0 Then
        oRng.Select
        If MsgBox("Do you want to remove underline from this instance", vbYesNo, "Actio") = vbYes Then
          oRng.Font.Underline = wdUnderlineNone
        End If
        oRng.Collapse 0
      End If
      Else
        Exit Do
      End If
   Loop
  End With
lbl_Exit:
  Set oRng = Nothing
  Set oScope = Nothing
  Exit Sub
End Sub

[Seatonian]

Hello Greg, Thank you for picking up the baton and running a bit further. I have been working on your latest Version, but need more time for solid progress. The "Stepping" mechanism is fine, but it will only delete single Underlines despite my attempt to add wdUnderlineThick and wdUnderlineDouble into the .Find section. I will work on it more, then contact you again if it won't work.


I'm afraid the MsgBox will have to go as it obscures the screen so I can't see which Underline is in focus. I seem to remember fixing something similar years ago. I'll try to find it and work on it some more and get in touch in a couple of days. Thank you again for all the trouble you have taken.
Robert.

[gmayor]

The following will remove any type of underline. If the message box obscures the item drag it out of the way.

Sub Delete_Underlines()
' 'Graham Mayor - http://www.gmayor.com - Last updated - 06 Oct 2018
'
' Delete_Underlines Macro
' Will delete all underlines in Document except in Mail addresses (& hyperlinks ??)
Const strUline As String = "1|2|3|4|6|9|10|11|20|23|25|26|27|39|43|55"
Dim vUline As Variant
Dim oRng As Range
Dim oWord As Range
Dim i As Long
    vUline = Split(strUline, "|")
    For i = 0 To UBound(vUline)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Font.Underline = CLng(vUline(i))
            .Replacement.ClearFormatting
            Do While .Execute()
                If oRng.Hyperlinks.Count = 0 Then
                    oRng.Select
                    If MsgBox("Do you want to remove underline from this instance", vbYesNo) = vbYes Then
                        oRng.Font.Underline = wdUnderlineNone
                    End If
                    oRng.Collapse 0
                End If
            Loop
        End With
    Next i
lbl_Exit:
    Set oRng = Nothing
    Set oWord = Nothing
    Exit Sub
End Sub

[Seatonian]

Thank you, Graham, for the definitive Underline Deletion Macro for all 17 Styles of Line. It works perfectly. I have spent several hours studying the sophisticated Code and learned much in the process. Brilliant ! I asked for a bicycle and got a Rolls Royce. Thank you for your patience.... and your genius.


My thanks to all other kind contributors for their generosity. Have a splendid day.

[gmaxey]

I was tinkering with something similar yesterday before my grandchildren blew in like a tempest. I wasn't taking it as far as Graham has (e.g., I was only interested in the three underline styles that you enumerated) but I did want the user to see apparent order in processing. Here I've combined Graham's work with a bit of my own.

Sub Delete_Underlines()
'Graham Mayor - http://www.gmayor.com - Last updated - 06 Oct 2018
'Adapted by y Greg Maxey, http://gregmaxey.com/word_tips.html, 10/7/2018
' Delete_Underlines Macro
' Will delete all underlines in Document except in Mail addresses (& hyperlinks ??)
Const strUline As String = "1|2|3|4|6|9|10|11|20|23|25|26|27|39|43|55"
Dim vUline As Variant
Dim oRng As Range
'Dim oWord As Range Deleted GKM
Dim i As Long
Dim lngCount As Long 'Added GKM
Dim arrRanges() As String 'Added GKM
  vUline = Split(strUline, "|")
  For i = 0 To UBound(vUline)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .Font.Underline = CLng(vUline(i))
      .Replacement.ClearFormatting
      Do While .Execute()
        If oRng.Hyperlinks.Count = 0 Then
          'Instead of processig here, just collect the affected ranges.
           ReDim Preserve arrRanges(lngCount)
           arrRanges(lngCount) = oRng.Start & "|" & oRng.End
           lngCount = lngCount + 1
           oRng.Collapse 0
        End If
     Loop
    End With
  Next i
  'Sort the affected ranges.
  WordBasic.SortArray arrRanges
  Set oRng = ActiveDocument.Range
  'Process the affected ranges in the order they occur.
  For i = 0 To UBound(arrRanges)
    oRng.Start = Split(arrRanges(i), "|")(0)
    oRng.End = Split(arrRanges(i), "|")(1)
    oRng.Select
    If MsgBox("Do you want to remove underline from this instance", vbYesNo) = vbYes Then
        oRng.Font.Underline = wdUnderlineNone
    End If

  Next i
lbl_Exit:
  Set oRng = Nothing
  'Set oWord = Nothing Deleted GKM
  Exit Sub
End Sub