This is just a roughly wrote function, so not completed (never anyway).
Test this and see how it goes.
Function StrArrange(ByVal txt As String) As String
    Static RegX As Object
    Dim i As Long, m As Object, myStr As String
    If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = "\b(HE(XAGON|AD)|MACHINE|NICKEL ALLOY|ZINC PLATED?|COUNTERSUNK|SOCKET)\b"
        If .test(txt) Then
            For i = .Execute(txt).Count - 1 To 0 Step -1
                Set m = .Execute(txt)(i)
                Select Case True
                    Case m Like "HEX*": myStr = "HEX"
                    Case m = "HEAD": myStr = "HD"
                    Case m Like "MA*": myStr = "M/C"
                    Case m Like "NIC*": myStr = "NI/AL"
                    Case m Like "Z*": myStr = "ZONC PLT"
                    Case m Like "C*": myStr = "CSK"
                    Case m Like "S*": myStr = "SKT"
                End Select
                txt = Application.Replace(txt, m.firstindex + 1, m.Length, myStr)
            Next
        End If
        .Pattern = "\b(S(T(AINLESS)?)?[ /])?S(T(EEL)?)?\b"
        If .test(txt) Then
            If .Execute(txt)(0).submatches(0) <> "" Then
                txt = .Replace(txt, "ST/ST")
            Else
                txt = .Replace(txt, "ST")
            End If
        End If
        .Pattern = "((^\S* *(NUT|BOLT|WASHER|SCREW))| (NUT| BOLT| WASHER| SCREW))S?\b"
        If .test(txt) Then
            StrArrange = .Execute(txt)(0).submatches(1) & .Execute(txt)(0).submatches(3): txt = .Replace(txt, "")
        End If
        .Pattern = "\bHEX\b"
        If .test(txt) Then
            StrArrange = StrArrange & " " & .Execute(txt)(0): txt = .Replace(txt, "")
        End If
        .Pattern = "\bM\d+\b"
        If .test(txt) Then
            StrArrange = StrArrange & " " & .Execute(txt)(0)
            txt = .Replace(txt, "")
        End If
        StrArrange = Application.Trim(StrArrange & " " & txt)
    End With
End Function