Sub ORFO(Str As Long, Stlb As Long)
'Определим строку
j = 1
For i = 1 To Len(Cells(Str, Stlb).Value)
If i + 1 > Len(Cells(Str, Stlb).Value) Then
    If Application.CheckSpelling(Mid(Cells(Str, Stlb).Value, j, i - j + 1)) = False Then
   'Выделим
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = -16777024
    Else
    'Восстановим цвет
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = 0
    End If
Else
 If Mid(Cells(Str, Stlb).Value, i + 1, 1) = " " Or _
Asc(Mid(Cells(Str, Stlb).Value, i + 1, 1)) = 10 Or (i = Len(Cells(Str, Stlb).Value) And j = 1) _
Then
   If Application.CheckSpelling(Mid(Cells(Str, Stlb).Value, j, i - j + 1)) = False Then
   'Выделим
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = -16777024
    Else
    'Восстановим цвет
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = 0
   End If
   j = i + 2
 End If
End If
Next i
End Sub

'Ну и пропишем событие, например:


Private Sub Worksheet_Change(ByVal Target As Range)
Call ORFO(Target.Row, Target.Column)
End Sub

Sub AddRecordsByFieldValue(StartRow As Integer, ColumnNumber As Integer)
i = StartRow
Do
If Cells(i, ColumnNumber).Value <> 0 Then
NumberOfRowToInsert = Cells(i, ColumnNumber).Value
For j = 1 To NumberOfRowToInsert
Cells(i + j, ColumnNumber).EntireRow.Insert Shift:=xlDown
Next
i = i + j
Else
Exit Do
End If
Loop
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call AddRecordsByFieldValue(ActiveCell.Row, ActiveCell.Column)
End Sub