How to hard code a range of cells to be filled with a background color?

[johnnyL]

I can't believe I that I can't figure this seemingly simple goal of always having a certain range of cells set to a background color. I have tried formatting the range via right clicking the highlighted range and then 'Format cells\fill'. This seems to work, just until I rerun the script, that is when the colored cell ranges change from what I set it up to originally.

Example Goal:

HardCodedRangeFillColorTestV1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Colour	Qty	Ordered
2	Black	14	18	2
3	Blue	3	4	2	Red	14	6		Green	8	3		Blue	1	3		Brown	4	10		Black	2	5
4	Brown	4	10	1	Blue	2	1		Purple	2	7		Red	4	2						Green	6	1
5	Green	19	6	3	Green	5	2		Orange	6	1										Orange	4	7
6	Orange	10	8	2					Red	0	5										Purple	8	3
7	Purple	10	10	2					Yellow	4	9
8	Red	18	13	3					Black	12	13
9	Yellow	4	9	1
Sheet1

Wrong result that occurs after rerunning the same script:

HardCodedRangeFillColorTestV1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Colour	Qty	Ordered
2	Black	14	18	2
3	Blue	3	4	2	Red	14	6		Green	8	3		Blue	1	3		Brown	4	10		Black	2	5
4	Brown	4	10	1	Blue	2	1		Purple	2	7		Red	4	2						Green	6	1
5	Green	19	6	3	Green	5	2		Orange	6	1										Orange	4	7
6	Orange	10	8	2					Red	0	5										Purple	8	3
7	Purple	10	10	2					Yellow	4	9
8	Red	18	13	3					Black	12	13
9	Yellow	4	9	1
Sheet1

How do I keep the initial range of colored cells from changing? The data displayed hasn't changed, so why are the colored cell ranges changing?

 

[Michael M]

and the code you are using is ????

 

[johnnyL]

and the code you are using is ????

Thank you @Michael M for your response. The macro is not color change oriented at all, if that is what you were suspecting.

Sub JonnyL2()
   Dim Cl As Range
   Dim Tmp As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("E3:W8").SpecialCells(xlConstants, xlTextValues)
         If Not .Exists(Cl.Value) Then
            .Item(Cl.Value) = Array(Cl.Offset(, 1).Value, Cl.Offset(, 2).Value, 1)
         Else
            Tmp = .Item(Cl.Value)
            Tmp(0) = Tmp(0) + Cl.Offset(, 1).Value
            Tmp(1) = Tmp(1) + Cl.Offset(, 2).Value
            Tmp(2) = Tmp(2) + 1
            .Item(Cl.Value) = Tmp
         End If
      Next Cl
      Range("A2").Resize(.Count, 1).Value = Application.Transpose(.Keys)
      Range("B2").Resize(.Count, 3).Value = Application.Index(.Items, 0)
      Range("A1").Resize(.Count, 4).Sort Range("A1"), xlAscending, , , , , , xlYes
   End With
End Sub

 

[Michael M]

So this line throws it...
Range("A1").Resize(.Count, 4).Sort Range("A1"), xlAscending, , , , , xlYes
But after 3 runs it's back to normal !!

 

[johnnyL]

So this line throws it...
Range("A1").Resize(.Count, 4).Sort Range("A1"), xlAscending, , , , , xlYes
But after 3 runs it's back to normal !!

Sorry @Michael M, I am a bit confused by your response.

I just now tested your theory of rerunning the script several times, I am not sure how that answers my original question though. It actually took me 5 times to get it back to the original range of colored cells, but when I ran it again, right back to the wrong ranges of colored cells.

That being said, I am still wondering how to answer my original question.

 

[Michael M]

apologies....I too, am confused....not by you, but the code result doesn't make sense.
I will continue to play with it, unless someone else steps in.

 

[johnnyL]

Thank you @Michael M.

 

[johnnyL]

So this line throws it...
Range("A1").Resize(.Count, 4).Sort Range("A1"), xlAscending, , , , , xlYes

I agree with that. Each time that line is triggered, it seems that the ranges of colored cells changes.

As I originally stated, I just don't get what is making this so complicated. LOL

 

[johnnyL]

There has to be a better solution than this:

Sub JonnyL2()
'
   Dim Cl As Range
   Dim Tmp As Variant
'
    For StupidMaintainCellRangeWithColorWorkAround = 1 To 5                                                         <----
        With CreateObject("scripting.dictionary")
            For Each Cl In Range("E3:W8").SpecialCells(xlConstants, xlTextValues)
                If Not .Exists(Cl.Value) Then
                    .Item(Cl.Value) = Array(Cl.Offset(, 1).Value, Cl.Offset(, 2).Value, 1)
                Else
                    Tmp = .Item(Cl.Value)
                    Tmp(0) = Tmp(0) + Cl.Offset(, 1).Value
                    Tmp(1) = Tmp(1) + Cl.Offset(, 2).Value
                    Tmp(2) = Tmp(2) + 1
                    .Item(Cl.Value) = Tmp
                End If
            Next Cl
'
            Range("A2").Resize(.Count, 1).Value = Application.Transpose(.Keys)
            Range("B2").Resize(.Count, 3).Value = Application.Index(.Items, 0)
            Range("A2").Resize(.Count, 4).Sort Range("A2"), xlAscending, , , , , , xlNo
        End With
    Next StupidMaintainCellRangeWithColorWorkAround                                                                 <----
End Sub

Man this is ticking me off.

 

[Fluff]

Why not just reset the colour at the end of the code

Range("A:D").Interior.Color = xlNone
Range("A2:D4").Interior.Color = rgbGreen