Nested Loop Array

[teodoro]

I have a matrix composed of 6 rows and 15 columns. The top-leftmost cell is B5. The 15 columns is subdivided to 5 main headings, each heading composed of 3 columns.

Column 1 is the Project Cost (in dollars)
Column 2 is the Project name
Column 3 is the Project Lagtime (in days)
​

Each row represents the projects per main heading.

I want to automate a procedure in placing a circle shape on top of the project name based on this condition dual condition:

If cost > 100 place Oval 1
If cost > 50 place Oval 2
If cost > 15 place Oval 3
If cost < 15 place Oval 4

If lagtime > 120 red fill on the oval
If lagtime > 90 yellow fill on the oval
If lagtime > 60 violet fill on the oval
If lagtime > 30 blue fill on the oval
If lagtime < 30 green fill on the oval
​

Looking at the first project (cells B5 to D5), I tried to hardcode the proecedure (below) and it worked for the 1st project. My problem is how to loop it such that the procedure will be performed in all the projects in my matrix (30 projects). I am having hard time doing an array and doing the For-Next Looping. Any help will be appreciated. Thanks - Teodoro

Sub NAInsertBubbles()
If Range("b5").Value > 100 Then
ActiveSheet.Shapes("Oval 1").Select
Selection.Copy
Range("c5").Select
ActiveSheet.Paste
If Range("d5").Value > 120 Then
' Fill red
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
End With

ElseIf Range("d5").Value > 90 Then
' Fill yellow
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 13
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 60 Then
' Fill violet
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 20
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 30 Then
' Fill blue
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0.5
End With

Else
' Fill green
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
.Fill.Transparency = 0.3
End With

End If

ElseIf Range("b5").Value > 50 Then

ActiveSheet.Shapes("Oval 2").Select
Selection.Copy
Range("c5").Select
ActiveSheet.Paste
If Range("d5").Value > 120 Then
' Fill red
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
End With

ElseIf Range("d5").Value > 90 Then
' Fill yellow
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 13
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 60 Then
' Fill violet
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 20
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 30 Then
' Fill blue
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0.5
End With

Else
' Fill green
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
.Fill.Transparency = 0.3
End With

End If
ElseIf Range("b5").Value > 15 Then

ActiveSheet.Shapes("Oval 3").Select
Selection.Copy
Range("c5").Select
ActiveSheet.Paste
If Range("d5").Value > 120 Then
' Fill red
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
End With

ElseIf Range("d5").Value > 90 Then
' Fill yellow
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 13
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 60 Then
' Fill violet
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 20
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 30 Then
' Fill blue
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0.5
End With

Else
' Fill green
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
.Fill.Transparency = 0.3
End With

End If
Else
ActiveSheet.Shapes("Oval 4").Select
Selection.Copy
Range("c5").Select
ActiveSheet.Paste
If Range("d5").Value > 120 Then
' Fill red
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10
.Fill.Transparency = 0.5
End With

ElseIf Range("d5").Value > 90 Then
' Fill yellow
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 13
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 60 Then
' Fill violet
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 20
.Fill.Transparency = 0.3
End With

ElseIf Range("d5").Value > 30 Then
' Fill blue
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0.5
End With

Else
' Fill green
With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
.Fill.Transparency = 0.3
End With

End If
End If

​

 

[Mala]

Try this code with the data sheet active - you may need to change the address list (shown red) for the cost cells - if I got your description right I don't think you would need to:

Sub NAInsertBubbles2()
    Dim shp As Shape
    CostArr = Array(10000, 100, 50, 15)
    LagArr = Array(10000, 120, 90, 60, 30)
    OvalArr = Array("Oval 1", "Oval 2", "Oval 3", "Oval 4")
    ColorArr = Array(10, 13, 20, 12, 17)
    TransparencyArr = Array(0.5, 0.3, 0.3, 0.5, 0.3)
    For Each Cell In Range("B5,E5,H5,K5,N5,B6,E6,H6,K6,N6,B7,E7,H7,K7,N7,B8,E8,H8,K8,N8,B9,E9,H9,K9,N9,B10,E10,H10,K10,N10").Cells
        Cost = Cell.Value: Lag = Cell.Offset(0, 2).Value
        MCost = Application.Match(Cost, CostArr, -1): MLag = Application.Match(Lag, LagArr, -1)
        OvalNm = Application.Index(OvalArr, MCost)
        OvalClr = Application.Index(ColorArr, MLag)
        OvalTrans = Application.Index(TransparencyArr, MLag)
        With Cell.Offset(0, 1):  Tp = .Top:  Lft = .Left:  Ht = .Height:  End With
        Set shp = ActiveSheet.Shapes(OvalNm).Duplicate
        With shp
           .Top = Tp + Ht / 2 - .Height / 2:  .Left = Lft
           .Fill.ForeColor.SchemeColor = OvalClr
           .Fill.Transparency = OvalTrans
        End With
    Next Cell
End Sub

 

[teodoro]

Thanks a lot for your response. I will try this if it will work.

 

[Mala]

Wow! And thank you!