edit vba code for display In Exponential Form

[p45cal]

duplicate of http://vbaexpress.com/forum/showthread.php?t=46060 and cross-posted http://www.xtremevbtalk.com/showthread.php?t=325884.

Try:[VBA]Sub Prime3()
Dim n, i As Long, s As String, Res()
ReDim Res(0 To 0), ExpoLen(0 To 0), ExpoPosn(0 To 0)
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
ReDim Preserve Res(0 To UBound(Res) + 1)
Res(UBound(Res)) = i
n = n \ i
Else
i = i + 1
End If
Loop
myexponent = 1
For i = 1 To UBound(Res)
If i < UBound(Res) Then
If Res(i) = Res(i + 1) Then
myexponent = myexponent + 1
Else
'Stop
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
myexponent = 1
Else
mystring = mystring & "*" & Res(i)
End If
End If
Else
'last or only value
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
Else
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
End If
End If
Next i
ActiveCell.Offset(, 2) = mystring
For i = 1 To UBound(ExpoLen)
ActiveCell.Offset(, 2).Characters(Start:=ExpoPosn(i), Length:=ExpoLen(i)).Font.Superscript = True
Next i
End Sub
[/VBA]This is not perfect, there is a least one bug - working on it.