Sub IndexUpdater()
Application.ScreenUpdating = False
Dim i As Long, strStl As String, strRef As String, Rng As Range
Set Rng = Selection.Range
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
With Rng
  For i = 1 To .Fields.Count
    With .Fields(i)
      If .Type = wdFieldIndexEntry Then
        If .Code.Fields.Count = 1 Then
          With .Code.Fields(1)
            If .Type = wdFieldStyleRef Then
              strStl = .Code.Paragraphs(1).Style
              strRef = Split(Split(.Code.Text, "STYLEREF")(1), Chr(34))(1)
              If strRef <> strStl Then .Code.Text = Replace(.Code.Text, strRef, strStl)
            End If
          End With
        End If
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub