Macro to sum and concatenate by color

brett1966 · Jan 10, 2022

Hi All,

I am trying to build a "Time table" to assist with programing irrigation controllers as well as a visual display of how the program looks over a 24 hour period in our orchard (there will be 7 of these calendars - 1 for each day to show the full week of irrigation). The Orchard is divided up into irrigation sections. To which I have assigned colors (but I would like these colors to be added to if I want to add more shifts.....I will explain. I am trying to achieve 3 things in creating a Shift Summary.

1. I want to return the start of a Shift which is represented as time
2. Concatenate the sections in a shift
3. Sum the total minutes per shift.
Please note the times and order of shifts and minutes will change depending on irrigation needs

I have found some code to sum the minutes per irrigation per color but I am not able to adapt it to achieve the other 2 outcomes. I am going around in circles trying to get it to work.

Your expertise would be greatly appreciated.

TIA
Brett

irrigation Shift Summary.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

1

Saturday, 1 January 2022

Shift Summary

2

Time of Day

0:00

1:00

2:00

3:00

4:00

5:00

6:00

7:00

8:00

9:00

10:00

11:00

12:00

13:00

14:00

15:00

16:00

17:00

18:00

20:00

22:00

0:00

4:00

8:00

12:00

18:00

3

Section

V1

V2

Q1

Q2

E1

E2

V1

V2

Q1

Q2

E1

E2

F1

F2

H

I

J

V1 V2 Q1 Q2

E1 E2

V1 V2 Q1 Q2

E1 E2 F1 F2

H I J

4

Minutes per irrigation

60

120

60

240

120

240

Sheet1

Cell Formulas
Range	Formula
X4	X4	=SumColor(X2,B4:V4)
Y4	Y4	=SumColor(Y2,B4:V4)
Z4	Z4	=SumColor(Z2,B4:V4)
AA4	AA4	=SumColor(AA2,B4:V4)
AB4	AB4	=SumColor(AB2,B4:V4)

Rijnsent · Jan 13, 2022

Hi Brett,
can you post the VBA code you came up with so far? If I understand it correctly you have SumColor, which solves question 3, but are missing functions for the other 2 questions? So you would need 2 extra functions: =ConcatenateColor(cell_with_color,range_to_concat) and =FirstValueColor(cell_with_color,range_to_check) ?
Thanks,
Koen

brett1966 · Jan 14, 2022

Rijnsent said:
Hi Brett,
can you post the VBA code you came up with so far? If I understand it correctly you have SumColor, which solves question 3, but are missing functions for the other 2 questions? So you would need 2 extra functions: =ConcatenateColor(cell_with_color,range_to_concat) and =FirstValueColor(cell_with_color,range_to_check) ?
Thanks,
Koen

Hi Koen,

thanks for your response. I have continued to work on this and a solution came to me in the middle of the night.

I found some VBA code that would return the color number of a colored cell (unfortunately I can't find the place where I got it from to credit the person who wrote and posted it. See code,

VBA Code:

Function GetCellColor(xlRange As Range)
  Dim indRow, indColumn As Long
  Dim arResults()
 
  Application.Volatile
 
  If xlRange Is Nothing Then
      Set xlRange = Application.ThisCell
  End If
 
  If xlRange.Count > 1 Then
    ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
     For indRow = 1 To xlRange.Rows.Count
       For indColumn = 1 To xlRange.Columns.Count
         arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
       Next
     Next
   GetCellColor = arResults
  Else
   GetCellColor = xlRange.Interior.Color
  End If
End Function

I then thought that I can use this color number as a reference to calculate (sum) cells and return the values (concatenate) I need of the specific colored cells.
( I hope that makes sense)

irrigation Shift Summary.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

1

12:00 AM

1:00 AM

2:00 AM

3:00 AM

4:00 AM

5:00 AM

6:00 AM

7:00 AM

8:00 AM

9:00 AM

10:00 AM

11:00 AM

12:00 PM

1:00 PM

2:00 PM

3:00 PM

4:00 PM

5:00 PM

6:00 PM

7:00 PM

8:00 PM

9:00 PM

10:00 PM

11:00 PM

12:00 AM

Order Summary

2

Hours of the day

0:00

Date

3

Sunday, 9 January 2022

V1

V2

Q1

Q2

E1

E2

H-G

V1-Q2

E1-F2

ABC

Time

4

Minutes

60

240

180

240

Hours

5

Litres Per Second

2

32

7

16

Litres/Sec

6

Section

Sheet1

Cell Formulas
Range	Formula
C2:Y2	C2	=B2+B4/1440
AB2	AB2	=A3
AC2	AC2	=A3
AD2	AD2	=A3
AE2	AE2	=A3
AF2	AF2	=A3
AG2	AG2	=A3
AH2	AH2	=A3
AB3	AB3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AB2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AC3	AC3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AC2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AD3	AD3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AD2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AE3	AE3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AE2),COLUMN(B2:Y2))),COLUMN(B6:Y6))),"")
AF3	AF3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AF2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AG3	AG3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AG2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AH3	AH3	=IFERROR(INDEX(B2:Y2,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AH2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AB4	AB4	=SumColor(AB2,B4:Y4)/60
AC4	AC4	=SumColor(AC2,B4:Y4)/60
AD4	AD4	=SumColor(AD2,B4:Y4)/60
AE4	AE4	=SumColor(AE2,B4:Y4)/60
AF4	AF4	=SumColor(AF2,B4:Y4)/60
AG4	AG4	=SumColor(AG2,B4:Y4)/60
AH4	AH4	=SumColor(AH2,B4:Y4)/60
AB5	AB5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AB2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AC5	AC5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AC2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AD5	AD5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AD2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AE5	AE5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AE2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AF5	AF5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AF2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AG5	AG5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AG2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AH5	AH5	=IFERROR(INDEX(B5:Y5,MATCH(MIN(IF(GetCellColor(B2:Y2)=GetCellColor(AH2),COLUMN(B2:Y2))),COLUMN(B2:Y2))),"")
AB6	AB6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B3:Y3)=GetCellColor(AB2),B3:Y3,""))
AC6	AC6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B3:Y3)=GetCellColor(AC2),B3:Y3,""))
AD6	AD6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B2:Y2)=GetCellColor(AD2),B3:Y3,""))
AE6	AE6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B2:Y2)=GetCellColor(AE2),B3:Y3,""))
AF6	AF6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B3:Y3)=GetCellColor(AF2),B3:Y3,""))
AG6	AG6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B2:Y2)=GetCellColor(AG2),B3:Y3,""))
AH6	AH6	=TEXTJOIN(" ",TRUE,IF(GetCellColor(B2:Y2)=GetCellColor(AH2),B3:Y3,""))

The code behind the SumColor function (sourced from Leila Gharani on her youtube channel)

VBA Code:

Function SumColor(MatchColor As Range, sumRange As Range) As Double

    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    
    For Each cell In sumRange
        If cell.Interior.Color = myColor Then
        SumColor = SumColor + cell.Value
       End If
       Next cell
End Function

This seems to work.

Thank you once again Koen. I appreciate your interest in my enquiry.

Rijnsent · Jan 14, 2022

Hi Brett,
that looks good! I'd consider learning a bit more VBA, it's a really handy skill to help with (further) automating Excel tasks

. Anyhow, if you're still interested, this would be a way to do it in VBA. As you can probably see, the functions are just a tiny bit different.
Cheers,
Koen

VBA Code:

Function SumByColor(MatchColor As Range, sumRange As Range) As Double
    
    'Source: https://www.youtube.com/watch?v=OrAvtXI8zVw
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    SumByColor = 0
    For Each cell In sumRange
        If cell.Interior.Color = myColor Then
            SumByColor = SumByColor + cell.Value
        End If
    Next cell
End Function

Function ConcatByColor(MatchColor As Range, concatRange As Range) As String
    
    'Source: https://www.mrexcel.com/board/threads/macro-to-sum-and-concatenate-by-color.1192274/#post-5816004
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    ConcatByColor = ""
    
    For Each cell In concatRange
        If cell.Interior.Color = myColor Then
            'Put the strings together with a space in between
            ConcatByColor = ConcatByColor & " " & cell.Value
        End If
    Next cell
    ConcatByColor = Trim(ConcatByColor)
End Function

Function FirstByColor(MatchColor As Range, dataRange As Range) As String
    
    'Source: https://www.mrexcel.com/board/threads/macro-to-sum-and-concatenate-by-color.1192274/#post-5816004
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    FirstByColor = ""
    
    For Each cell In dataRange
        If cell.Interior.Color = myColor Then
            FirstByColor = cell.Value
            'If one is found, exit the loop
            Exit For
        End If
    Next cell
End Function

brett1966 · Jan 14, 2022

Rijnsent said:

Hi Brett,
that looks good! I'd consider learning a bit more VBA, it's a really handy skill to help with (further) automating Excel tasks

. Anyhow, if you're still interested, this would be a way to do it in VBA. As you can probably see, the functions are just a tiny bit different.
Cheers,
Koen

VBA Code:

Function SumByColor(MatchColor As Range, sumRange As Range) As Double
   
    'Source: https://www.youtube.com/watch?v=OrAvtXI8zVw
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    SumByColor = 0
    For Each cell In sumRange
        If cell.Interior.Color = myColor Then
            SumByColor = SumByColor + cell.Value
        End If
    Next cell
End Function

Function ConcatByColor(MatchColor As Range, concatRange As Range) As String
   
    'Source: https://www.mrexcel.com/board/threads/macro-to-sum-and-concatenate-by-color.1192274/#post-5816004
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    ConcatByColor = ""
   
    For Each cell In concatRange
        If cell.Interior.Color = myColor Then
            'Put the strings together with a space in between
            ConcatByColor = ConcatByColor & " " & cell.Value
        End If
    Next cell
    ConcatByColor = Trim(ConcatByColor)
End Function

Function FirstByColor(MatchColor As Range, dataRange As Range) As String
   
    'Source: https://www.mrexcel.com/board/threads/macro-to-sum-and-concatenate-by-color.1192274/#post-5816004
    Dim cell As Range
    Dim myColor As Long
    myColor = MatchColor.Cells(1, 1).Interior.Color
    FirstByColor = ""
   
    For Each cell In dataRange
        If cell.Interior.Color = myColor Then
            FirstByColor = cell.Value
            'If one is found, exit the loop
            Exit For
        End If
    Next cell
End Function

Thank's Koen, I will use your code on a mockup spreadsheet and give it a go.

Again appreciate your interest and time

Cheers
Brett

Macro to sum and concatenate by color

brett1966

New Member

Excel Facts

Rijnsent

Well-known Member

brett1966

New Member

Rijnsent

Well-known Member

brett1966

New Member

Similar threads

Forum statistics

Share this page

Macro to sum and concatenate by color

brett1966

New Member

Excel Facts

Rijnsent

Well-known Member

brett1966

New Member

Rijnsent

Well-known Member

brett1966

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock