Looping question

[Rune_Daub]

Also..
I have a situation where I have 6 shapes that I need to color. The
colour varies after a number of variables. All six shapes have the same
variables, but for different areas. So far I set up the folowing.
(Shortend text)

Private Sub Worksheet_Activate()
Dim vValStorkunder As Double
Dim vValSmb As Double

vValStorkunder =
Evaluate("Max(if(Medarbejderdata!C1:C2000=""Storkunder"",Medarbejderdata!G1:G2000,0))")
vValSmb =
Evaluate("Max(if(Medarbejderdata!C1:C2000=""SMB"",Medarbejderdata!G1:G2000,0))")

If vValStorkunder = 0 Then
ActiveSheet.Shapes("pzlStorkunder").Fill.ForeColor.SchemeColor = 9 '
White
End If
If vValStorkunder = 1 Then
ActiveSheet.Shapes("pzlStorkunder").Fill.ForeColor.SchemeColor = 22 '
Grey
End If

If vValSmb = 0 Then
ActiveSheet.Shapes("pzlSmb").Fill.ForeColor.SchemeColor = 9 ' White
End If
If vValSmb = 1 Then
ActiveSheet.Shapes("pzlSmb").Fill.ForeColor.SchemeColor = 22 ' Grey
End If
End Sub

Just imagine the above text with 6 different vVals and 5 different
result for colours.

Can I do this an a loop somehow, so that I dont have to define the same
5 Fill.Foreclor.SchemeColor for each vVal I make?

I thought of a
For Each Shape in ActiveSheets.Shapes
or something. I just dont know how to set it up...

thx
Rune Daub

 

[Dave Peterson]

Maybe you could keep track of the values in an array:

Option Explicit
Option Base 0

Private Sub Worksheet_Activate()

Dim vVal() As Double
Dim myWordsToCheck As Variant
Dim myShapeNames As Variant
Dim iCtr As Long

myWordsToCheck = Array("Storkunder", "SMB", "StorkOver", "SMC")
myShapeNames = Array("PzlStorkunder", "pzlsmb", "pzlstorkover", "pzlsmc")

ReDim vVal(LBound(myWordsToCheck) To UBound(myWordsToCheck))

For iCtr = LBound(myWordsToCheck) To UBound(myWordsToCheck)
vVal(iCtr) = Evaluate("Max(if(Medarbejderdata!C1:C2000=""" _
& myWordsToCheck(iCtr) _
& """,Medarbejderdata!G1:G2000,0))")
Next iCtr

For iCtr = LBound(myWordsToCheck) To UBound(myWordsToCheck)
If vVal(iCtr) = 0 Then
Me.Shapes(myShapeNames(iCtr)).Fill.ForeColor.SchemeColor = 9
' White
ElseIf vVal(iCtr) = 1 Then
Me.Shapes(myShapeNames(iCtr)).Fill.ForeColor.SchemeColor = 22
' Grey
End If
Next iCtr

End Sub