VBA code to underline numbers in the header takes significant time and sometimes crashes excel
ActiveSheet.PageSetup.CenterHeader = "" &amp; z &amp; ""



There's no reason to run this instruction at every single iteration as z is still in the process of being concatenated, is there?

Move it out of the loop and assign PageSetup.CenterHeader once, only when you've figured out the entire final string value - this could have a dramatically positive impact on performance :)

The name of the procedure/macro should not have underscores in it; convention is to use PascalCase for procedure/member names.

The procedure is implicitly Public and could use an explicit access modifier.

Reading the name of the procedure I was expecting it to go through page headers and underline whatever numeric values are in there... but that's not what's happening, and the variable names aren't helping much. Take the time to spell them out, and thank yourself later!

That said I'd suggest taking in a Workbook parameter and removing the ActiveWorkbook and ActiveSheet dependencies, which force any VBA code calling this procedure to Select and Activate things, which as you know isn't ideal.

Actually, the procedure has too many responsibilities, that's why its name feels wrong. It should be a function that takes a String argument and returns the formatted string: that's what I would expect a "make numbers underline" procedure to do. Then another procedure can be responsible for knowing what worksheet to interact with, and for setting its PageSetup.CenterHeader:

Dim headerText As String
headerText = UnderlineNumbers(ActiveWorkbook.Name)
ActiveSheet.PageSetup.CenterHeader = headerText


The string-valued Mid$ function should work slightly better than the similar but variant-valued Mid function, and when the current character is being pulled from the string in 3 places, it's time to introduce a local variable ;-)

This should be pretty much instant:

Private Function UnderlineNumbers(ByVal value As String) As String
    Dim result As String
    Dim i As Long
    For i = 1 To Len(value)
        Dim current As String
        current = Mid$(value, i, 1)
        If IsNumeric(current) Then
            result = result &amp; "&amp;U" &amp; current &amp; "&amp;U"
        Else
            result = result &amp; current
        End If
    Next
    UnderlineNumbers = result
End Function