Herbers Excel-Forum - das Archiv

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Zelle As Range
    Dim objRange As Range, objCell As Range
    Dim lngPostition As Long
    Application.EnableEvents = False
    Set objRange = Intersect(Target, Range(Cells(4, 2), Cells(Rows.Count, 2)))
    If Not objRange Is Nothing Then
        For Each objCell In objRange
            lngPostition = InStr(1, objCell.Value, " VKA ", vbTextCompare)
            If lngPostition <> 0 Then
                With objCell.Characters(lngPostition + 1, 3)
                    .Text = UCase$(.Text)
                    .Font.Bold = True
                    .Font.Color = RGB(71, 71, 255)
                End With
            End If
        Next
        Set objRange = Nothing
    End If
    If Not Intersect(Target, Range("C1")) Is Nothing Then
        If Selection.Cells.Count > 1 Then
            For Each Zelle In Selection
                If Zelle.Value = "" Then
                    Zelle.Value = "Enter the style number here."
                End If
            Next
            Exit Sub
        End If
        If Target = "" Then
            Target = "Enter the style number here."
        End If
    End If
    Application.EnableEvents = True
End Sub