VBA for Case with Like must have wildcard

[Livin404]

Good evening, I start out with a formula then determined it would not be efficient since I did not want the end values in my "Result" Column.

This VBA is set directly into Sheet 1, we need it to update automatically.

The following code I think is getting me in the right direction. I do see ////KG being placed in the first one; however, my Excel then quickly shuts done. I also need to add one line that the only time this macro works is when it meets the "TE*" requirement. I think I'll need an else option.

I added the Excel to the Dropbox: Worksheet VBA DROPBOX.xlsm


My code now is

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim result As String
For Each rng In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Select Case rng.Value
Case rng.Value Like "TE*"
result = "///KG"
End Select
rng.Offset(0, 2).Value = result
Next
End Sub

Thank you very much indeed.

 

[kevin9999]

See if this works any better:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Application.ScreenUpdating = False
            Dim r As Range
            For Each r In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
                If r Like "TE*" Then
                    r.Offset(0, 2).Value = "///KG"
                End If
            Next r
    End If
Continue:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Livin404]

See if this works any better:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Application.ScreenUpdating = False
            Dim r As Range
            For Each r In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
                If r Like "TE*" Then
                    r.Offset(0, 2).Value = "///KG"
                End If
            Next r
    End If
Continue:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

Thank you for the quick response. I feel bad, because mine was nots even close. I notice we have a dialog box. Does that come up when there is no TE at all?

 

[kevin9999]

What does the dialog box say?