How to loop through Two arrays in TWO FOR Each loop

Question

There are two FOR EACH loops in the code below. The first FOR loop cycles through the first array (shape 1,shape 2 ,shape 3).The second FOR loop cycles through the second array (0.3, 0.4, 0.5).

Shape 1      0.3
Shape 2      0.4
Shape 3      0.5

The second FOR loop colors the shape on my worksheet based on the value of second array. The problem is all of my shapes are being colored with first value (i.e 0.3). I want Shape 1 to be colored based on 0.3 , Shape 2 based on 0.4 and so on. Thanks for helping me with this.

Private Sub Worksheet_Calculate()
    Dim arr1
    Dim arr2
    Set arr1 = Worksheets("Sheet2").Range("valueforarr1")
    Set arr2 = Worksheets("Sheet2").Range("Valueforarr2")
    Dim c, d As Range
    For Each c In arr1
        c = Replace(c, " ", "_")
        MsgBox c

        For Each d In arr2
            If d >= 0.2 And d <= 0.3 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
                Exit For
            ElseIf d > 0.3 And d <= 0.4 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(218, 238, 243) 
                Exit For
            ElseIf d > 0.4 And d <= 0.5 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(183, 222, 232) 
                Exit For
            ElseIf d > 0.5 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(146, 205, 220) 
                Exit For
            ElseIf d Is Nothing Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(255, 255, 255) 
                Exit For
            End If
        Next d
    Next c
End Sub

Are you trying to loop through ALL the shape objects on your sheet, or just a subset that you specify by name in a group of cells? Maybe you can backup a bit and tell us what you are trying to achieve. — aphoria
– aphoria, Commented Jul 3, 2014 at 10:36
Hi Aphoria, I have to color each shape (in my array arr1) with its corresponding value of color (in array arr2). So shape 1 should be colored according to 0.2 scale, Shape 2 to 0.3 and so on. The problem is with my second FOR loop, because all of my shapes are being colored based on the first value of arr2 array. — Malick
– Malick, Commented Jul 3, 2014 at 10:53
.Range("valueforarr1") and .Range("valueforarr2") are my dynamic named ranges from a pivot table which are providing values to my arr1 and arr2. — Malick
– Malick, Commented Jul 3, 2014 at 10:57

GEnGEr · Accepted Answer · 2014-07-03 10:23:03Z

1

Hmm.. i guess your Problem is the second loop.

You take the First Shape and match it with all Values of the second Range-loop

What your loops are doing is:

Shape 1 -> 0.3

Shape 1 -> 0.4

Shape 1 -> 0.5

than the same with Shape 2

Shape 2 -> 0.3

Shape 2 -> 0.4 etc.

So if im Right its always the last Value of Range2

Dim intRow As Integer
intRow = 1
For Each c In arr1
        c = Replace(c, " ", "_")
        MsgBox c
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.3" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.4" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.5" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
intRow=intRow+1
Next c

edited Jul 3, 2014 at 10:23

answered Jul 3, 2014 at 9:57

GEnGEr

2053 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Malick Over a year ago

Yeah right, the second loop is the issue here. Is there a way to skip the first value of second loop when its get executed second time.??

Malick Over a year ago

The color values are coming from a dynamic named range (Valueforarr2) which is based on a pivot table. I'm not sure how do I use Worksheets("Sheet1").Cells(intRow,2).value ??

GEnGEr Over a year ago

hmm... than try it with the your Range2 and the Offset comand excel-vba.com/vba-code-2-6-cells-ranges.htm

aphoria · Accepted Answer · 2014-07-03 11:58:06Z

0

I think this will do what you need. You will need to change the Set myShapes = ... and Set myValues = ... lines to point to your ranges.

Sub Worksheet_Calculate()
  Dim myShapes As Range
  Set myShapes = Worksheets("Sheet1").Range("A1:A5")
  Dim myValues As Range
  Set myValues = Worksheets("Sheet1").Range("B1:B5")

  For i = 1 To myShapes.Rows.Count
    Select Case myValues.Rows(i)
      Case Is = 0.3
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(237, 247, 249)
      Case Is = 0.4
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(218, 238, 243)
      Case Is = 0.5
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(183, 222, 232)
      Case Is > 0.5
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(146, 205, 220)
      Case Else
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(255, 255, 255)
    End Select
  Next i
End Sub

One note:

What you are calling arrays (arr1, arr2) are actually Range objects.

edited Jul 3, 2014 at 11:58

answered Jul 3, 2014 at 11:33

aphoria

20.3k8 gold badges67 silver badges76 bronze badges

2 Comments

Malick Over a year ago

Aphoria, if an item in my named range has space (e.g. Shape 1) and the actual shape name is with underscore(e.g. Shape_1) in my worksheet, how do I tackle it, as i am getting an error ' the item with the specified name was not found". i have tried myShapes = Replace(myShapes, " ", "_"), but this doesn't work.

aphoria Over a year ago

Change shapes(i) to Replace(myShapes(i), "_", " ") in each Worksheets(... statement inside each Case ... statement.

Collectives™ on Stack Overflow

How to loop through Two arrays in TWO FOR Each loop

2 Answers 2

3 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related