VBA: Changing Interior Color of Dictionary Array Item

[mykulpasskwa]

Hello, I have set up a dictionary that looks at term years and individually adds each term with matching years. I am trying to highlight the array item that goes over a limit, but I can't figure out how to reference the array item to the cell range it's associated with. I haven't worked with dictionaries before a couple days ago. Normally I would use something like ws.Range("F" & i).Interior.Color = 15652797 but that clearly doesn't work in this case.

In this case the terms all start with 2019 and the limit is 15, the the sum of 201910 and 201930 meets or exceeds that limit so I want to set the color to yellow. I have it working where arr(1) is 201910, arr(2) is 201930, and arr(3) is 201950. So if arr(2) is the item that equals or exceeds the limit, how can I reference that item so I can change the color of the offset value?

The code is much larger than this, but this is the relevant part I think:

        If Year1 = Year2 Then 
            termsubtotal = arr(i, 5) + arr(i + 1, 5)
            If termsubtotal < benefitresult Then 
                    'Changes array item to Blue (Interior color = 15652797)
            Else
                If termsubtotal >= benefitresult Then
                    'Changes array item to Yellow (Interior color = 65535)
            Else
                If Year1 <> Year2 Then
                    termsubtotal = termsubtotal + arr(i, 5)
                End If
            End If

I'm willing to provide more if requested, but figured I'd get rid of some irrelevant things.

 

[DanteAmor]

In your example, you add 5 + 10, so 15 = 15, therefore you want to highlight the cell with the value 10.
And then you want to add 10 + 20?
Or what would be the next step?
Or do you just want to compare 5 + 10?

 

[mykulpasskwa]

In your example, you add 5 + 10, so 15 = 15, therefore you want to highlight the cell with the value 10.
And then you want to add 10 + 20?
Or what would be the next step?
Or do you just want to compare 5 + 10?

Right, I want to highlight 10 because 5+10 has reached or exceeded the limit of 15. If it were 6+10 I would still want to highlight it. All I'm doing is finding the limit and highlighting the term that reached or exceeded that limit. If the limit were 35 I would want to add the 20 and highlight that cell, but in this example nothing needs to happen because the limit is 15 and has already been passed.

I need to do this for any term year, so this needs to be repeated across 2020, 2018, 2100 or any other group of terms. The terms are always together and in chronological order from oldest to most recent year. Hope that makes sense! ?

 

[DanteAmor]

Sorry but I still do not understand, with a single example it is difficult to understand.
Do you want this in a cycle?
You could put more examples, show which ones you want highlighted in yellow and explain 3 of them.

 

[mykulpasskwa]

Sorry but I still do not understand, with a single example it is difficult to understand.

I completely get you. I've been trying to figure out how I can make this work for over a year now. Hopefully this helps.

Conditions

• The term column has three groups: 2017, 2019, and 2020. The last two digits do not matter other than to differentiate the part of term within that year.
• Each of those groups has a defined limit in the limit column (which I have set as constants in VBA editor). When our client reaches that limit is important because we need to switch them to a different benefit.
  • The limit can be reached in any term. The below example has two similar instances to emphasize the annually changing limit.

Examples

• In the 2017 group the limit is 3 and since 201710 is 1 and 201730 is 2 they have reached their limit in 201730 and the 2 should be highlighted yellow
  • Since they've already gone over the limit it doesn't matter what happens to 201760 as long as it's not yellow because now they are using a different benefit
• The 2019 group is the same idea as 2017, but the limit is 15 instead of 3.
• In 2020 the limit shoots up to 100 but they never use all of their benefits so nothing changes.

• What you helped me do previously (thank you!) is get the benefit column to sum the total of each group...2017 = 6, 2019 = 35, 2020 = 70
• What I have done based on your help is have excel make a dictionary of each term and add them one-by-one with the intention of changing the color of the value that corresponds to the term they went over the limit
  • 1 + 2 = 3, 3 + 3 = 6...[new group, counter resets] 5 + 10 = 15, 15 + 20 = 35...[new group, counter resets]...etc.
• What I'm trying to do is compare the counter against a constant (the limit), so when the counter is equal to or greater than the limit it turns the value that corresponds to the term they went over the limit.

It's complicated and there's a lot to consider but I know there's a way to do it. I'm just too inexperienced and don't know the right tools to use yet. I hope that clears it up, but if not I'm happy to walk through it more. I could talk about this all day but I appreciate your time and patience!

 

[DanteAmor]

Thanks for the explanation and the image.
You could confirm the following:
Does the data start in cell A4?
Are the "limits" in column A in merged cells?

 

[mykulpasskwa]

The data starts in B4. I only added the limit column (A) as a demonstration. The limits are in VBA editor as a Constant and I'm using a Select Case to find the limit of the year being evaluated.

 

[DanteAmor]

The data starts in B4

Try this:

Sub Changing_Interior_Color()
  Dim a As Variant, ant As Variant
  Dim nMax As Double, lim As Long, i As Long, lr As Long
  Dim r As Range, bColor As Boolean
  
  lr = Range("B" & Rows.Count).End(3).Row
  a = Range("B4:F" & lr).Value2
  Range("F4:F" & lr).Interior.Color = xlNone
  ant = Left(a(1, 1), 4)
  
  For i = 1 To UBound(a, 1)
    Select Case Left(a(i, 1), 4)
      Case "2017": lim = 3
      Case "2018": lim = 10
      Case "2019": lim = 15
      Case "2020": lim = 100
    End Select
    
    If ant <> Left(a(i, 1), 4) Then
      nMax = 0
      bColor = False
    End If
    
    nMax = nMax + a(i, 5)
    If nMax >= lim And bColor = False Then
      bColor = True
      If r Is Nothing Then Set r = Range("F" & i + 3) Else Set r = Union(r, Range("F" & i + 3))
    End If
    ant = Left(a(i, 1), 4)
  Next
  r.Interior.Color = vbYellow
End Sub

 

[DanteAmor]

I have set up a dictionary

I show you another version using a dictionary

Sub Changing_Interior_Color()
  Dim a As Variant, r As Range, dic As Object
  Dim nMax As Double, lim As Long, i As Long, nYear As Long
  
  a = Range("B4:F" & Range("B" & Rows.Count).End(3).Row).Value2
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = 1 To UBound(a, 1)
    nYear = Left(a(i, 1), 4)
    Select Case nYear
      Case 2017: lim = 3
      Case 2018: lim = 10
      Case 2019: lim = 15
      Case 2020: lim = 100
    End Select
    
    If Not dic.exists(nYear) Then
      dic(nYear) = Empty
      nMax = a(i, 5)
    Else
      nMax = nMax + a(i, 5)
      If nMax >= lim And dic(nYear) = Empty Then
        dic(nYear) = "x"
        If r Is Nothing Then Set r = Range("F" & i + 3) Else Set r = Union(r, Range("F" & i + 3))
      End If
    End If
  Next
  If Not r Is Nothing Then r.Interior.Color = vbYellow
End Sub

 

[mykulpasskwa]

How did you get so good at this?! lol That works perfectly. Its so simple and clean too. You just saved me so much time. Thank you 100 times over.