Public Sub InsertApostrophe()
Dim rng As Excel.Range
Dim rngSel As Excel.Range
Dim s As String
Dim calcs As Excel.XlCalculation
calcs = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo cleanup
If StrComp(LCase(TypeName(Selection)), "range") <> 0 Then
Err.Raise 12536, "InsertApostrophe()", "No cell range selected. Operation not valid."
End If
Set rngSel = Selection
For Each rng In rngSel.Cells
On Error Resume Next
s = CStr(rng.Value)
On Error GoTo cleanup
If StrComp(Left$(s, 1), "'") <> 0 And IsNumeric(s) Then
s = "'" & s
rng.Value = s
End If
Next rng
cleanup:
Application.Calculation = calcs
If Err.Number <> 0 Then
Call MsgBox("An error occured." & vbCrLf & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, Err.Source)
End If
End Sub