VBA for Case with Like must have wildcard

Question

VBA for Case with Like must have wildcard

Anonymous

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: https://www.dropbox.com/scl/fi/2s2v368w3zg4hgdf7nvr8/Worksheet-VBA-DROPBOX.xlsm?dl=0&rlkey=f0oojnlexajos88mucxoeciii

My code now is

Private Sub Worksheet_Change(ByVal Target As Range)Dim rng As RangeDim result As StringFor Each rng In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)Select Case rng.ValueCase rng.Value Like "TE*"result = "///KG"End Selectrng.Offset(0, 2).Value = resultNextEnd Sub

Thank you very much indeed.

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

3 answers

Answer 1

Hi,

[make a copy before..]

you may try this approach

replace the above change event

with

double click event

(for update, double click in a cell)

=====================

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rng As Range

Application.ScreenUpdating = False

Application.EnableEvents = False

For Each rng In Range("B:B").SpecialCells(xlCellTypeConstants)

If rng.Value Like "TE*" Then

rng.Offset(0, 13).Value = "///KG"

Else

rng.Offset(0, 13).Value = ""

End If

Next rng

Application.EnableEvents = True

Application.ScreenUpdating = True

Target.Offset(, 1).Select

End Sub

Answer 2

Thank you so much, and my deepest apologies for the long wait. I had a few issues come up with work.

I tweaked the macro ever so slightly. It does work. However, it seems I have to go to the existing data click in the cell hit enter then the she will update. Is there a more proficient way to avoid doing that? I know you talked about enabling events. I could temporary insert another column then drag the cells over that would update .

It is now

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As RangeDim result As StringIf Not Intersect(Range("B:B"), Target) Is Nothing ThenApplication.ScreenUpdating = FalseApplication.EnableEvents = FalseFor Each rng In Intersect(Range("B:B"), Target)If rng.Value Like "TE*" Thenrng.Offset(0, 13).Value = "///KG"End IfNext rngApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueEnd IfEnd Sub

Answer 3

When you change values in a Worksheet_Change event procedure, you should always set Application.EnableEvents to False temporarily to avoid the procedure from calling itself over and over again.

And you should only process cells that have changed, instead of all cells in a range.

Finally, there is no need for using Select Case here.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim result As String
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each rng In Intersect(Range("A:A"), Target)
            If rng.Value Like "TE*" Then
                rng.Offset(0, 2).Value = "///KG"
            End If
        Next rng
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Share via

VBA for Case with Like must have wildcard

3 answers