Worksheet Change_Event not working on cell value change

[Lil Stinker]

Hey folks-
I'm still learning my way through Excel VBA and I've hit another seemingly simple roadblock. Maybe you can help me understand what's going on here or provide better code.

I would like to have a shape display whenever any cell within a range has a specific word appear. My code is pretty straightforward, and it works whenever I enter the word but what I don't understand is why it doesn't work when I load the same word into the cell range from another worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("D16:D42")) Is Nothing Then
   If InStr(Target.Value, "cat") Then
      Shapes("shape1").Visible = msoCTrue 'show image
   Else
      Shapes("shape1").Visible = msoFalse 'hide image
   End If
End If

Specifically, if the word "cat" appears in any one cell in the Range ("D16:D42"), I want Shape1 to display. If all the cells in the range say "cat", I want Shape1 to appear just once, not duplicated for every instance "cat" comes up. If none of the cells show "cat" then Shape1 should not appear. My cells in the range are merged so technically the range may be "D16:E42". They also have the same data validation list embedded for each. If I select anything from the list that has the word "cat" in it or I type "cat" in any of these cells, Shape1 appears. However, there is another way this range is populated and that is by loading saved details from Sheet2 into Sheet1. Essentially, Sheet1 is a form for users to fill out using the drop-down options in D16:D42 while Sheet2 is the record where previous form details are saved. Whenever the details are loaded from Sheet2 into the same cell range on Sheet1 and the word "cat" appears, Shape1 does not display unless I click the drop-down and select the same line again. Not very practical since Shape1 should display automatically.

Transferring the details is a simple value for value transfer:

      lastitemRESULTROW = Sheet2.Range("M1048576").End(xlUp).Row
      If lastitemRESULTROW < 3 Then GoTo NoItems
      For resultROW = 3 To lastitemRESULTROW
         qtITEMROW = Sheet2.Range("T" & resultROW).Value 'form result row
         If qtITEMROW < 3 Then
            Clear_Form 'entry has been deleted, move on, nothing to load here
            GoTo NoItems
         End If
         .Range("D" & qtITEMROW & ":H" & qtITEMROW).Value = Sheet2.Range("O" & resultROW & ":S" & resultROW).Value 'copy result dsc, st date, qty, rate
         .Range("AA" & qtITEMROW).Value = Sheet2.Range("U" & resultROW).Value 'copy result item row
      Next resultROW
NoItems:

Even when I run a Debug.Print to see what cells are changing during the change_event, D16:D42 appear. What is it I'm missing? Shouldn't Shape1 appear whether I enter cat into the cell or whether Excel does?

I realize since D:E are merged Target.CountLarge should be > 2 but even when I played with that, it made no difference. I also played with changing the Range from ("D16:D42") to ("D16:E42"). Still nothing. I also took out "Else Shapes("shape1").Visible=msoFalse". Still nothing.

Please help

 

[JoeMo]

Hey folks-
I'm still learning my way through Excel VBA and I've hit another seemingly simple roadblock. Maybe you can help me understand what's going on here or provide better code.

I would like to have a shape display whenever any cell within a range has a specific word appear. My code is pretty straightforward, and it works whenever I enter the word but what I don't understand is why it doesn't work when I load the same word into the cell range from another worksheet.


Please help

The first line of your code (If Target.CountLarge > 1 Then Exit Sub) ensures that if the target is more than one cell the code will not run beyond that line. Remove this line then try something like this and be sure that the range you paste in from Sheet2 is merged identically to sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ct, c As Range
If Not Intersect(Target, Range("D16:D142")) Is Nothing Then
    For Each c In Intersect(Target, Range("D16:D42"))
        If InStr(1, c.Value, "cat") > 0 Then
            Ct = Ct + 1
            If Ct > 1 Then Exit For
            Shapes("shape1").Visible = msoCTrue 'show image
        Else
            Shapes("shape1").Visible = msoFalse 'hide image
        End If
    Next c
End If
End Sub

 

[Lil Stinker]

Is there a way to turn off Target.CountLarge for this specific event without deleting the line altogether? The problem is I have several other change_events running before this one that require it. Or should I just move this event to the top of the list and put the count large line after it?

So you’re saying I should have the cells merged together on Sheet2 as well as on Sheet1?

Finally, what is Ct dimensioned as? Is that a range too?

 

[JoeMo]

Why do you want the Target.CountLarge>1 possibility to be excluded by exiting the sub anyway? If a user copies and pastes something more than a single cell to the specified range why would you not want to respond to it?

If sheet1 merges each pair D16:E16, D17:E17, .... D42:E42, then if you want to copy from sheet2 and paste to sheet1 the copied range on sheet2 must be merged identically to the destination range on sheet1.

The Ct variable is dimensioned as a variant. It counts the number of times "cat" is found in the change or changes in the specified range on sheet1. It is used to stop looking at the changed cells once any changed cell contains "cat" since you said in your OP: "If all the cells in the range say "cat", I want Shape1 to appear just once, not duplicated for every instance "cat" comes up. If none of the cells show "cat" then Shape1 should not appear."

 

[Lil Stinker]

Almost there! Your code works for both loading and changing the value manually in the cell so I'm one step closer. However, when changing it manually as you go row by row on the form, the shape comes and goes. If I enter "cat" into D16 and then "dog" into D17, the shape shows up with "cat" but goes away with "dog". Enter "cat" into D18, shape comes back. Is there a way to have the shape show and stay visible whenever any cell within the range shows "cat" even if the other cells don't?

 

[JoeMo]

Does this do what you want?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim M
M = Application.Match("*cat*", Range("D16:D42"), 0)
If Not IsError(M) Then
    Shapes("shape1").Visible = msoTrue
Else
    Shapes("shape1").Visible = msoFalse
End If
End Sub

 

[Lil Stinker]

Wow, that works like a charm!
One last question, I have Option Explicit turned on, yet I don't get any errors when M is not Dim M as... something. Why is that?

Thank you so much!

 

[bebo021999]

Dim M
(=Dim M As Varian)

Dim M&
(=Dim M As Long)

Dim M$
(=Dim M As String)

 

[JoeMo]

Wow, that works like a charm!
One last question, I have Option Explicit turned on, yet I don't get any errors when M is not Dim M as... something. Why is that?

Thank you so much!

You are welcome- thanks for the reply.

 

[Lil Stinker]

Dim M
(=Dim M As Varian)

Dim M&
(=Dim M As Long)

Dim M$
(=Dim M As String)

Thanks, bebo, that's good to know!