Vba Code

[Varghesetcm]

I have a work book and i had set a vba code to Count the data from sheet regarding colours , i need more modules as when i change colours it is not getting updated in the total .
2 ndly i need to get the pie chart Colours to change according to the Colours in the data area.

Department: HVAC									Month	January
Floor	8th	9th	10th	11th	12th	14th	15th	16th	17th	18th	19th	Date	No. of Rooms
Rooms	801	901	1001	1101	1201	1401	1501	1601	1701	1801	1901	Total Rooms	116
802	902	1002	1102	1202	1402	1502	1602	1702	1802	1902	7-Jan-22	23
803	903	1003	1103	1203	1403	1503	1603	1703	1803	1903	14-Jan-22	6
804	904	1004	1104	1204	1404	1504	1604	1704	1804		21-Jan-22	13
805	905	1005	1105	1205	1405	1505	1605	1705			28-Jan-22	0
806	906	1006	1106	1206	1406	1506	1606	1706
807	907	1007	1107	1207	1407	1507	1607	1707
808	908	1008	1108	1208	1408	1508
809	909	1009	1109	1209	1409	1509
810	910	1010	1110	1210
811	911	1011	1111	1211
812	912	1012	1112	1212
814	914	1014	1114	1214
815		1015	1115
816		1016	1116
817		1017	1117
818		1018	1118

 

[shknbk2]

Welcome to the forum.

Can you provide the VBA code you currently have?

 

[Varghesetcm]

Function GetColorCount(CountRange As Range, CountColor As Range)
Dim CountColorValue As Integer
Dim TotalCount As Integer
CountColorValue = CountColor.Interior.ColorIndex
Set rCell = CountRange
For Each rCell In CountRange
If rCell.Interior.ColorIndex = CountColorValue Then
TotalCount = TotalCount + 1
End If
Next rCell
GetColorCount = TotalCount
End Function

 

[shknbk2]

For now, I just focused on getting the totals to work as you expect. The chart can come later.

I don't find anything wrong with your function. I made a test Sub based on your data to call the function to test it out, and it seems to work fine. I also added checking for TintAndShade, though, in case the fill color palette was used for a darker/lighter shade of the same ColorIndex, but other than that, it seems to work fine.

Can you explain a little more about when you add new colors, the totals don't update? Also, what process are you using to update the totals?

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Department: HVAC									Month	January
2	Floor	8th	9th	10th	11th	12th	14th	15th	16th	17th	18th	19th	Date	No. of Rooms
3	Rooms	801	901	1001	1101	1201	1401	1501	1601	1701	1801	1901	Total Rooms	116
4		802	902	1002	1102	1202	1402	1502	1602	1702	1802	1902	7-Jan-22	19
5		803	903	1003	1103	1203	1403	1503	1603	1703	1803	1903	14-Jan-22	13
6		804	904	1004	1104	1204	1404	1504	1604	1704	1804		21-Jan-22	3
7		805	905	1005	1105	1205	1405	1505	1605	1705			28-Jan-22	1
8		806	906	1006	1106	1206	1406	1506	1606	1706
9		807	907	1007	1107	1207	1407	1507	1607	1707
10		808	908	1008	1108	1208	1408	1508
11		809	909	1009	1109	1209	1409	1509
12		810	910	1010	1110	1210
13		811	911	1011	1111	1211
14		812	912	1012	1112	1212
15		814	914	1014	1114	1214
16		815		1015	1115
17		816		1016	1116
18		817		1017	1117
19		818		1018	1118
Sheet1

Sub UpdateColorTotals()
    Dim rooms As Range
    Dim totalCell As Range
    
    Set rooms = Range("B3:L19")
    For Each totalCell In Range("N4:N7")
        totalCell.Value = GetColorCount(rooms, totalCell)
    Next
End Sub

Function GetColorCount(CountRange As Range, CountColor As Range) As Integer
    Dim CountColorValue As Integer
    Dim CountColorTintShade As Double
    Dim TotalCount As Integer
    Dim rCell As Range
    
    CountColorValue = CountColor.Interior.ColorIndex
    CountColorTintShade = CountColor.Interior.TintAndShade
    Set rCell = CountRange
    For Each rCell In CountRange
        If rCell.Interior.ColorIndex = CountColorValue And _
          rCell.Interior.TintAndShade = CountColorTintShade Then
            TotalCount = TotalCount + 1
        End If
    Next rCell
    GetColorCount = TotalCount
End Function

 

[Varghesetcm]

Dear in the chart when i finsh checking room i will highlight the cells with colours used but after colouring the cells the total is not updating every time i have to go to the data cell for each colour and double click to get the total.

 

[shknbk2]

Oh, I see. That's a problem that has some discussion on the Internet. See HERE, for example. From this page, I added the following to my Sheet1 code, and although the totals don't update when I make the change to the selected cell, when I select a different cell, the totals update.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.CalculateFullRebuild
End Sub