Modify Code for multiple objects and cells

[jeffst]

Hello,

I am a novice with VBA, but I was able to get this code to work. The problem is that I want the code to apply to 29 other objects. the range of cells are from row 118 to row 123 and columns 26 to 30 (30 cells total). Each object is tied to the outcome of each cell. If the cell is blank, the corresponding object is not visible. How can I add to this code to get it to apply to all of my 30 objects?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 118 And Target.Column = 26 Then
If Target.Value <> vbNullString Then
ActiveSheet.Shapes("Arc 120").Visible = True
Else
ActiveSheet.Shapes("Arc 120").Visible = False
End If
End If
End Sub

 

[John_w]

You are saying that the cells are Z118:AD123. Is there any rule or pattern which links each of these cell addresses to their associated shape names or the cell location of each shape? If so then the code below could be made much shorter. If not, then try expanding the code below, adding Case statements for all 30 cells and modifying the shape names as needed.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("Z118:AD123")) Is Nothing And Target.Count = 1 Then
        Select Case Target.Address(False, False)
            Case "Z118"
                ActiveSheet.Shapes("Arc 120").Visible = Target.Value <> vbNullString
            Case "Z119"
                ActiveSheet.Shapes("Arc 2").Visible = Target.Value <> vbNullString
            Case "Z120"
                ActiveSheet.Shapes("Arc 3").Visible = Target.Value <> vbNullString
        End Select
    End If
    
End Sub

Also, the above code assumes that only 1 cell at a time can change and would need changing if more than 1 cell at a time can change.

 

[jeffst]

Thanks John,

To answer your question, the cells Z118:AD123 are based on a pattern, calendar work days (M-F). In each cell, a formula pulls from a list of set dates (giving "1" or " "), which then was supposed to trigger this code to make the object shapes appear or not. There probably is an easier way to do it, but this was the easiest way I found at the time. Avoiding the excel date codes seemed to make sense.

Also, more than 1 cell can change at any time. I think your new code gets us closer, but we need a few more changes to make it work.

Jeff

 

[John_w]

Based on the above code, so it needs expanding for all 30 cells, this handles multiple cell changes:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim TargetCell As Range
    
    If Not Intersect(Target, Range("Z118:AD123")) Is Nothing Then
        For Each TargetCell In Target
            Select Case TargetCell.Address(False, False)
                Case "Z118"
                    ActiveSheet.Shapes("Arc 120").Visible = TargetCell.Value <> vbNullString
                Case "Z119"
                    ActiveSheet.Shapes("Arc 2").Visible = TargetCell.Value <> vbNullString
                Case "Z120"
                    ActiveSheet.Shapes("Arc 3").Visible = TargetCell.Value <> vbNullString
            End Select
        Next
    End If
    
End Sub

To answer your question, the cells Z118:AD123 are based on a pattern, calendar work days (M-F).

But is there a rule or pattern which links those cells to the shapes? A rule that VBA code can use so that the code can be reduced. For example, if I rename each shape to the name of its associated cell, "Z118", "Z119", "Z120", etc. then the following code works for all 30 cells and shapes:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim TargetCell As Range
    
    If Not Intersect(Target, Range("Z118:AD123")) Is Nothing Then
        For Each TargetCell In Target
            ActiveSheet.Shapes(TargetCell.Address(False, False)).Visible = TargetCell.Value <> vbNullString
        Next
    End If
    
End Sub

NB I had to use the Selection Pane (Alt+F10) to rename the shapes. Renaming them via the Name Box doesn't work because the new names are cell addresses and Excel just jumps to the cell instead of renaming the shape.

 

[jeffst]

I tried both of the methods, but the objects remained the same. I was expecting all of them to disappear except for the ones tied to a cell value of "1". When I toggled them in the selection pane, there was no difference whether the cell value was "1" or " ".

 

[jeffst]

There is no formula that links the shapes to the cells, only the VBA code. The 30 shapes do correspond to each of the 30 cells in a nameable pattern, so renaming the shapes to each cell might work. I did try that thought and the shapes did not disappear. With my original code, I was able to get one shape to disappear/reappear when the cell value was " " or "1". There must be something else that we need to change in the code.

 

[John_w]

There is no formula that links the shapes to the cells, only the VBA code. The 30 shapes do correspond to each of the 30 cells in a nameable pattern, so renaming the shapes to each cell might work. I did try that thought and the shapes did not disappear.

What is the pattern? What did you rename the shapes to?

My 2nd code in post 4 assumes the cells and shape names correspond as follows:

Cell - Shape Name
Z118 - "Z118"
Z119 - "Z119"
Z120 - "Z120"
:
AD121 - "AD121"
AD122 - "AD122"
AD123 - "AD123"

With my original code, I was able to get one shape to disappear/reappear when the cell value was " " or "1". There must be something else that we need to change in the code.

My 1st code in post 4 should work with cell Z118 and shape "Arc 120" (from your original code), but if it isn't obvious you need to change the other shape names in the code ("Arc 2", "Arc 3") to the names of the shapes which correspond to cells Z119 and Z120, and add similar lines for the other 27 cells and shapes.

 

[jeffst]

My 1st code in post 4 should work with cell Z118 and shape "Arc 120" (from your original code), but if it isn't obvious you need to change the other shape names in the code ("Arc 2", "Arc 3") to the names of the shapes which correspond to cells Z119 and Z120, and add similar lines for the other 27 cells and shapes.

I did exactly that. I changed each of the shape names in the code to the names of the shapes accordingly and modified each line. When I finished, I changed some of the cells from " " to "1" to test and nothing happened to the shapes.

What is the pattern? What did you rename the shapes to?

My 2nd code in post 4 assumes the cells and shape names correspond as follows:

Cell - Shape Name
Z118 - "Z118"
Z119 - "Z119"
Z120 - "Z120"
:
AD121 - "AD121"
AD122 - "AD122"
AD123 - "AD123"

1) The shapes are actually over another section of cells away from my "Z118:AD123" range. The pattern would be that the shapes are arranged the same way as the cells are. Arc 120 would be top left and six rows down would be Arc 125 which is similar to how 118 in column "Z" goes down to row 123. Arc 126 is in the next column (to the right of Arc 125) which is similar to how 118 in column "AA" goes down to row 123. and so on. I don't think the pattern is as important as just getting the shape to appear/disappear when the particular cell changes from " " to "1".

2) I renamed the shapes exactly how it shows in your example. I did not enter "quote marks" when I changed the shape names, so Z118 cell would have a Z118 shape.

I hope that helps. We must be really close to solving this.

 

[John_w]

To answer your question, the cells Z118:AD123 are based on a pattern, calendar work days (M-F). In each cell, a formula pulls from a list of set dates (giving "1" or " "), which then was supposed to trigger this code to make the object shapes appear or not.

The formulas may explain why the Worksheet_Change code isn't working. The Worksheet_Change event will only fire on manual user changes, not changes made by a formula. The Worksheet_Calculate event must be used instead if the cells contain formulas.

I did exactly that. I changed each of the shape names in the code to the names of the shapes accordingly and modified each line. When I finished, I changed some of the cells from " " to "1" to test and nothing happened to the shapes.

If you are changing the Z118:AD123 cells manually then Worksheet_Change should fire and show/hide the shapes.

2) I renamed the shapes exactly how it shows in your example. I did not enter "quote marks" when I changed the shape names, so Z118 cell would have a Z118 shape.

Omitting the quote marks is correct.

With formulas in cells Z118:AD123, and the corresponding shapes named as "Z118", "Z119", etc. (without the quotes), try this Worksheet_Calculate code (delete the Worksheet_Change code).

Private Sub Worksheet_Calculate()

    Dim cell As Range
    
    For Each cell In Me.Range("Z118:AD123")
        Me.Shapes(cell.Address(False, False)).Visible = cell.Value <> vbNullString
    Next

End Sub

 

[jeffst]

Ok, I deleted the old code and placed this in there, but I am getting a compile error: Invalid Outside Procedure and the first line of the new code is highlighted yellow on the debugger.