Set dynamic Range according to cell color / VBA

Question

I am trying to summarize data automatically generated and put into a format such as this.

I added the red cells in there so that they might help me set a range which is needed to extract data from the worksheet. The goal is to set a range from a cell with a number up to the next red cell (As is framed for the number 3 in the image). So far I have just put the range all the way up to the top cells, but that has caused a number of bugs with data transfer. The code looks as follows:

 For Each C In copyRng
        Set colSrc = C.EntireRow.Offset(0).Cells(1)
        If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
            Set rowRange = xSheet.Range(C, C.EntireColumn.Cells(1))

            For Each q In rowRange
                If InStr(1, q.Value, "C-") Then
                    Set rowSrc = q
                    Set colSrc = C.EntireRow.Offset(0).Cells(1)
                    Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
                    Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
                    Set exchSrc = q.EntireRow.Offset(-1).Cells(1)
                End If
            Next q

Is it possible to set such a range or should I try to find another way. The end goal is to figure out the Account number starting with C- right above the number and to ignore any number that has "Total" right above it.

Answer 1

I figured out another way. Instead of setting the range by color I set 2 ranges and used the first one to set the second one in an appropriate size. The code looks like this. I would be very interested if my first idea was possible anyway.

    For Each C In copyRng
        Set colSrc = C.EntireRow.Offset(0).Cells(1)
        If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
            Set SetRange = xSheet.Range(C, C.EntireColumn.Cells(1))
            For Each k In SetRange
                If InStr(1, k.Value, "C-") Or InStr(1, k.Value, "Total") Then Set setSource = k
            Next k

            Set rowRange = xSheet.Range(C, setSource)
            For Each q In rowRange
                If InStr(1, q.Value, "C-") Then
                    Set rowSrc = q
                    Set colSrc = C.EntireRow.Offset(0).Cells(1)
                    Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
                    Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
                    Set exchSrc = q.EntireRow.Offset(-1).Cells(1)

                    numCol = DestSh.Cells.Find(colSrc.Value, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
                    For Each u In DestSh.Range("A1:A548")
                        If rowSrc = u And yearSrc = u.Offset(0, 2) And exchSrc = u.Offset(0, 1) And qtrSrc = u.Offset(0, 3) Then numRow = u.Row
                    Next u

                    C.Interior.ColorIndex = 4
                    Set destRng = DestSh.Cells(numRow, numCol)
                    C.Copy destRng

                ElseIf InStr(1, q.Value, "Total") Then Exit For
                End If

            Next q