CODEWITHSUNDEEP
vbaexcelmacros
J.Con
J.Con

Reputation: 4309

Excel macro for superscripts?

I have the following data in Excel:

1.07 ± 0.35^a 1.21 ± 0.13^a 0.67 ± 0.31^a 1.43 ± 0.05^a

I am looking for a macro to change the text after the ^ symbol to superscript, whilst also removing the ^ symbol. I thought I had found the answer from this site http://www.beingbrunel.com/inline-subsuper-script-in-excel-and-more/, but I can't get the add-in to work.

This is my attempted code, but no cigar.

Sub Loop_Exampl()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet

    'We select the sheet so we can change the window view
    .Select

    'If you are in Page Break Preview Or Page Layout view go
    'back to normal view, we do this for speed
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    'Turn off Page Breaks, we do this for speed
    .DisplayPageBreaks = False

    'Set the first and last row to loop through
    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

    'We loop from Lastrow to Firstrow (bottom to top)
    For Lrow = Lastrow To Firstrow Step -1

        'We check the values in the A column in this example
        With .Cells(Lrow, "B")

        With ActiveCell.Characters(Start:=2, Length:=1).Font
            .Superscript = False
                .Subscript = True

End With

End Sub

Upvotes: 1

Views: 1670

Answers (2)

J.Con
J.Con

Reputation: 4309

This code will create superscripts of letters in the selected range, meaning that the ^ symbol is not required.

Sub FixFormatting() Dim c As Range Dim StartCells As Range Dim ws As Worksheet Dim intPlace As Integer Dim wsStartsProtected As Boolean

Application.ScreenUpdating = False
On Error GoTo errorCatch
Set StartCells = Selection
    For Each c In Selection.Cells
        With c
            .Replace What:="a", Replacement:="a", LookAt:=xlPart, MatchCase:=False
            .Replace What:="b", Replacement:="b", LookAt:=xlPart, MatchCase:=False
            .Replace What:="c", Replacement:="c", LookAt:=xlPart, MatchCase:=False

        End With
        intPlace = InStr(c.Value, "a")
        If intPlace > 0 Then
            If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
            c.Characters(intPlace, 1).Font.Superscript = True
        End If
        intPlace = InStr(c.Value, "b")
        If intPlace > 0 Then
            If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
            c.Characters(intPlace, 1).Font.Superscript = True
        End If
        intPlace = InStr(c.Value, "c")
        If intPlace > 0 Then
            If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
            c.Characters(intPlace, 1).Font.Superscript = True

        End If
        If wsStartsProtected Then ws.Protect
    Next
StartCells.Parent.Activate
StartCells.Select
Application.ScreenUpdating = True
Exit Sub

errorCatch: If wsStartsProtected Then ws.Protect StartCells.Parent.Activate StartCells.Select Application.ScreenUpdating = True End Sub

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166341

Not sure how you'd do this without the ^ Maybe superscript every letter which directly c=follows a digit ?

Sub tester()

    Dim c As Range

    For Each c In Selection.Cells
        SuperIt c
    Next c

End Sub

Sub SuperIt(rng As Range)

    Dim s, p, e

    s = rng.Text
    p = InStr(s, "^")

    If p > 0 Then
        Do
            e = 1
            Do While Mid(s, p + e, 1) <> " " And p + e < Len(s)
                e = e + 1
            Loop
            rng.Characters(p, 1).Delete
            rng.Characters(p, e).Font.Superscript = True

            s = rng.Text
            p = InStr(s, "^")
        Loop While p > 0
    End If
End Sub

Upvotes: 1

Related Questions