Sum, count and highlight max consecutive numbers

K

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000

Hi,

I have got data in column B
1-I want sum max consecutives in between intersections of "X" and put sum in column C
2-I need count max consecutives in between intersections of "X" and put sum in column D
3-Highlight max consecutives in the column B

Example data..


Book1
ABCDE
1DataSum Max ConsecutiveCount Max Consecutive
21,1,1,1,1,1,1,1,1,1,1,1,1,11414
31,1,1,1,1,1,1,1,1,1,1,2,1,11514
41,1,1,1,X,X,1,1,X,2,1,X,X,144
51,1,1,1,2,1,2,1,2,X,1,2,2,2129
61,1,1,1,2,X,X,X,2,1,2,X,2,X65
71,1,1,1,2,X,X,2,X,2,1,2,X,X65
81,1,1,X,2,1,1,2,1,X,2,1,X,275
91,1,1,2,1,1,2,1,X,2,1,2,X,1108
101,1,1,2,X,X,2,X,2,1,1,1,X,254
111,1,1,2,X,X,2,X,2,1,X,1,1,X54
121,1,X,1,X,1,X,X,X,1,1,2,2,X64
131,1,X,1,X,1,X,X,X,1,X,2,1,253
141,1,X,1,2,2,X,X,2,2,1,X,2,153
151,1,2,1,X,1,1,X,2,X,1,X,X,X54
161,1,2,1,X,X,X,1,X,2,X,2,1,154
171,1,2,1,X,X,X,1,X,2,2,1,2,X74
181,1,2,1,2,1,2,2,2,1,1,1,2,X1913
191,X,X,X,X,X,2,2,X,1,X,2,X,142
201,X,X,2,X,1,X,X,2,2,1,X,2,153
211,X,X,2,X,1,X,X,2,2,2,1,1,2106
221,2,2,X,X,1,X,2,X,2,X,X,2,153
231,2,2,X,X,1,X,2,X,2,2,2,1,185
241,2,2,2,1,1,2,1,1,1,2,1,1,X1813
251,2,2,2,1,2,1,2,1,X,2,1,2,X149
262,X,X,1,1,1,X,1,2,2,X,X,1,253
272,X,X,1,X,1,X,2,1,X,2,1,1,X43
282,X,X,1,X,2,X,2,X,1,1,2,2,X64
29X,1,1,1,1,X,1,1,2,2,2,X,2,285
30X,1,1,1,X,1,2,1,2,X,1,2,1,264
31X,X,2,X,2,X,2,1,2,2,1,2,X,1106
32X,X,2,X,2,2,X,2,1,2,2,1,X,X85
332,X,X,X,2,2,X,2,1,1,X,X,1,243
342,X,X,2,X,X,X,2,1,2,1,2,2,X106
352,X,X,2,X,X,X,2,1,2,X,2,2,153
362,X,X,2,X,2,1,X,1,2,2,2,1,X85
37X,X,1,2,1,2,2,X,X,X,X,X,1,X85
38X,X,1,2,2,1,2,1,2,1,2,2,X,21610
39X,X,X,X,1,1,1,1,2,X,1,2,2,165
40X,X,X,X,X,1,2,2,2,2,1,1,2,1149
41X,X,X,X,X,1,2,2,2,2,X,2,2,X95
42
43
44
Sheet1


Thank you in advance

Regards,
Kishan
 
Last edited:
Sort by date Sort by votes
Rick Rothstein said:
I changed the layout for your first scenario to make it easier for you to see. First change I made is to only have one Count column since if there are multiple maximum length sequences, they will always be of the same length, so I saw no reason to repeat the number. Second, you are assuming there will only be a maximum of two sequences of the same length, but that is not correct... you structure allows for up to 7 sequences of the same length. For example, consider this possible Column B value...

1,X,2,X,1,X,1,X,2,X,1,X,2,X

The next change to the layout is that I created 7 summation columns and gave each a different color... the color will match the color used to color the font for the sequence matching the summation position. I also made the color of the numbers in each summation column match the color used for the sequence in Column B. All of these changes should make the grid easier for you to use.... hopefully you will agree. Give this macro a try (all you need is Column B, the code will provide the rest).
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub LongestConsecutiveSequence()
  
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]

Note: I will look into your second scenario later tonight when I have more time.
Click to expand...
Rick, I loved your idea it is the best really compact and easier to view.:) I am speechless to see the magnificent results; it is the best of best setting you have made.

:pray:I am very thankful to you for giving an absolute solution.

Big thank you Rick (y)

Kind Regards,
Kishan :)

It is an Amazing!! Result Layout


Book1
ABCDEFGHIJK
1DataCountSum1Sum2Sum3Sum4Sum5Sum6Sum7
2X,1,1,1,1,2,1,X,2,1,X,2,X,267
31,2,2,2,2,2,X,2,2,2,2,2,2,X61112
42,1,X,1,1,X,1,2,1,1,X,X,X,145
51,2,1,1,X,X,X,1,1,1,2,1,1,X67
61,2,1,1,2,1,1,1,X,1,1,2,X,2810
7X,1,1,2,1,2,X,2,2,1,X,X,X,X57
81,1,X,1,2,2,X,1,2,1,2,2,X,258
9X,X,1,1,2,2,2,1,2,1,1,2,1,11217
102,X,2,X,X,2,X,1,1,X,1,X,1,X22
11X,1,X,X,1,1,2,1,2,1,1,1,1,21013
12X,1,1,1,1,1,1,1,2,X,2,1,1,289
131,2,2,X,1,2,1,1,2,1,X,1,1,168
14X,1,1,1,2,2,2,X,1,2,X,1,1,169
15X,1,1,1,2,X,X,1,1,X,1,1,1,1454
161,1,2,1,2,2,1,X,2,1,2,1,X,X710
171,X,1,X,1,X,1,X,1,2,2,X,1,235
181,1,X,1,X,2,X,2,1,2,X,1,X,X35
191,1,2,2,1,1,X,X,1,2,X,2,X,168
201,2,2,2,1,X,2,1,2,1,1,1,1,1810
212,1,1,X,X,2,2,1,2,1,1,1,X,2710
221,2,X,1,X,1,X,X,1,X,1,1,X,X232
231,1,1,X,X,1,1,X,1,2,1,X,1,1334
242,2,2,1,1,X,1,1,2,2,1,1,1,1810
25X,2,1,2,1,2,2,X,2,1,2,1,2,16109
262,1,2,1,1,X,2,X,X,X,2,2,1,257
271,X,1,X,X,1,2,2,1,2,1,1,2,X812
281,1,X,1,1,1,2,1,X,1,1,1,1,1565
291,1,X,2,1,1,1,X,1,2,X,2,1,145
302,1,X,1,X,1,1,1,1,2,2,X,2,X68
312,2,2,1,1,2,1,1,1,1,2,X,2,X1116
32X,1,2,1,1,X,1,1,2,1,2,1,1,1810
33X,X,X,1,1,1,2,2,1,1,1,2,2,11115
34X,X,2,X,X,2,X,1,2,2,1,2,2,X610
351,1,1,1,X,1,1,X,2,1,2,1,2,169
36X,1,2,1,2,2,1,2,1,1,2,X,1,11015
37X,X,1,2,2,2,1,1,1,X,2,1,1,X710
382,X,2,1,2,X,X,1,2,2,X,X,X,X355
392,2,X,X,1,X,1,1,1,1,1,X,1,X55
402,1,X,1,2,2,2,2,2,1,X,2,1,X712
412,1,2,1,1,X,1,1,2,X,1,2,X,157
422,X,2,2,1,1,1,X,1,1,1,1,X,157
431,2,X,2,2,2,1,2,X,1,1,1,2,1596
441,X,2,X,1,X,1,X,2,X,1,X,2,X11211212
45
46
47
Sheet5-8


​
​
 
Last edited:
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Kishan said:
It is an Amazing!! Result Layout

ABCDEFGHIJK
1DataCountSum1Sum2Sum3Sum4Sum5Sum6Sum7
2X,1,1,1,1,2,1,X,2,1,X,2,X,267
31,2,2,2,2,2,X,2,2,2,2,2,2,X61112
42,1,X,1,1,X,1,2,1,1,X,X,X,145

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>


​
Click to expand...
Your posted result layout is not showing the long sequence being colored... when you run my code, your actual data in Column B is getting colored, correct?
 
Upvote 0
Rick Rothstein said:
Your posted result layout is not showing the long sequence being colored... when you run my code, your actual data in Column B is getting colored, correct?
Click to expand...
Hi Rick, yes data in column B is being colored perfectly, as its showing in the long sequence. :) Which I can see in my sheet, but colours could not appeared in the excel question forum.

I am using MrExcelHtml, is there any other to post data in column B is being colored?

Thank you

Kind Regards,
Kishan

 
Upvote 0
Rick Rothstein said:
Your posted result layout is not showing the long sequence being colored... when you run my code, your actual data in Column B is getting colored, correct?
Click to expand...
Hi Rick, This is how looks the data in Column B is getting colored, it's coloring Perfect!!

B
1
Data
2
X,1,1,1,1,2,1,X,2,1,X,2,X,2
3
1,2,2,2,2,2,X,2,2,2,2,2,2,X
24
2,2,2,1,1,X,1,1,2,2,1,1,1,1
25
X,2,1,2,1,2,2,X,2,1,2,1,2,1
38
2,X,2,1,2,X,X,1,2,2,X,X,X,X
43
1,2,X,2,2,2,1,2,X,1,1,1,2,1
44
1,X,2,X,1,X,1,X,2,X,1,X,2,X

<tbody>
</tbody>
Sheet5-8​

Kind Regards,
Kishan
 
Upvote 0
Hi Rick, Please can you make a possible second scenario request Post#9 when you can, I can imagine it is not a quite simple.

Thank you in advance

Regards,
Kishan
 
Last edited:
Upvote 0
Kishan said:
Hi Rick, Please can you make a possible second scenario request Post#9 when you can, I can imagine it is not a quite simple.

Thank you in advance

Regards,
Kishan
Click to expand...
Since Rick hasn't responded, and I need a shot at redemption after not looking closely at what my code of post #2 was doing, here's some code to address your Scenario #2 from post #9 . I have altered the output to limit the count of consecutive cells to the max value and the sum to the max value where there are rows with more than one area meeting the max count. Data from a portion of your post #9 , Scenario2 layout, as produced by the code, are shown below the code.
Code: 
Sub Kishan()
Dim R As Range, i As Long, j As Long, k As Long, Vin As Variant, RTemp As Range
Dim Ct As Long, Ctmax As Long, S As Long, Smax As Long, Idx As Long
Set R = Range("C6").CurrentRegion.Offset(1, 0).Resize(Range("C6").CurrentRegion.Rows.Count - 1, Range("C6").CurrentRegion.Columns.Count)
Application.ScreenUpdating = False
For i = 1 To R.Rows.Count
    Vin = Application.Index(R.Rows(i).Value, 1, 0)
    For j = 1 To UBound(Vin)
        If Vin(j) <> "X" Then
            If RTemp Is Nothing Then
                Set RTemp = R.Cells(i, j)
                Ct = Ct + 1: If Ct >= Ctmax Then Ctmax = Ct
                S = S + Vin(j): If S >= Smax Then Smax = S
            Else
                Set RTemp = Union(RTemp, R.Cells(i, j))
                Ct = Ct + 1: If Ct >= Ctmax Then Ctmax = Ct
                S = S + Vin(j): If S >= Smax Then Smax = S
            End If
        Else
            Ct = 0: S = 0
        End If
    Next j
    If Not RTemp Is Nothing Then
        For k = 1 To RTemp.Areas.Count
            If RTemp.Areas(k).Count = Ctmax Then
                Idx = Idx + 3
                RTemp.Areas(k).Interior.ColorIndex = Idx
                R.Rows(i).Cells(1, 1).Offset(0, 16) = Ctmax
            End If
            If Application.Sum(RTemp.Areas(k)) = Smax Then R.Rows(i).Cells(1, 1).Offset(0, 17) = Smax
        Next k
    End If
    Set RTemp = Nothing
    Erase Vin
    Ct = 0: Ctmax = 0: S = 0: Smax = 0: Idx = 0
Next i
Application.ScreenUpdating = True
End Sub
Excel Workbook
CDEFGHIJKLMNOPQRST
6P1P2P3P4P5P6P7P8P9P10P11P12P13P14CountmaxSummax
7X111121X21X2X267
8122222X222222X612
921X11X1211XXX145
101211XXX111211X67
1112112111X112X2810
12X11212X221XXXX57
1311X122X12122X258
14XX1122212112111217
152X2XX2X11X1X1X22
16X1XX11212111121013
17X11111112X211289
18122X121121X11168
19X111222X12X11169
20X1112XX11X111145
211121221X2121XX710
221X1X1X1X122X1235
Scenario2
 
Upvote 0
Thanks for the reminder Joe... I had lost track of this thread. Here is my code to handle Scenario 2. Note that all you need to provide is the table in Columns C thru P... the code will draw the summary data in Column S thru Z (same output layout as was used for Scenario 1).
Code: 
[table="width: 500"]
[tr]
	[td]Sub LongestConsecutiveSequence2()
  Dim R As Long, X As Long, Z As Long, MaxLen As Long, Last As Long, LastRow As Long
  Dim V As Variant, Colors As Variant, CellVals As String
  Dim Sums(1 To 1, 1 To 7) As Variant, Seq(1 To 1, 1 To 7) As String
  Application.ScreenUpdating = False
  Columns("S:Z").Clear
  Colors = [{6,3,5,10,26,18,46,16}]
  Range("S6:Z6").Value = Array("Count", "Sum1", "Sum2", "Sum3", "Sum4", "Sum5", "Sum6", "Sum7")
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  With Range("S6")
    .BorderAround xlContinuous, xlThick, , vbBlack
    .HorizontalAlignment = xlCenter
    .Font.Bold = True
    .Copy
    .Resize(LastRow - 5, 8).PasteSpecial xlPasteFormats
  End With
  Range("S4").Select
  Application.CutCopyMode = False
  For X = 19 To 26  'Columns S thru Z
    With Cells(6, X)
      .Interior.ColorIndex = Colors(X - 18)
      If X > 19 Then .Font.Color = vbWhite
    End With
  Next
  For R = 7 To LastRow
    X = 0
    MaxLen = 0
    Erase Sums
    Erase Seq
    CellVals = Join(Application.Index(Cells(R, "C").Resize(, 14).Value, 1, 0), "")
    For Each V In Split(Application.Trim(Replace(CellVals, "X", " ")))
      If Len(V) > MaxLen Then
        X = 1
        Erase Sums
        Erase Seq
        MaxLen = Len(V)
        Sums(1, X) = Evaluate(Replace(StrConv(V, vbUnicode), Chr(0), "+") & 0)
        Seq(1, X) = V
      ElseIf Len(V) = MaxLen Then
        X = X + 1
        MaxLen = Len(V)
        Sums(1, X) = Evaluate(Replace(StrConv(V, vbUnicode), Chr(0), "+") & 0)
        Seq(1, X) = V
      End If
    Next
    Cells(R, "S").Value = MaxLen
    Cells(R, "T").Resize(, 7) = Sums
    Last = 0
    For Z = 1 To 7
      Range("S7").Offset(, Z).Resize(LastRow - 6).Font.Color = Range("S6").Offset(, Z).Interior.Color
      If Len(Seq(1, Z)) Then
        Last = InStr(Last + 1, CellVals & ",", Seq(1, Z))
        Cells(R, "B").Offset(, Last).Resize(, MaxLen).Interior.ColorIndex = Colors(Z + 1)
      End If
    Next
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
JoeMo said:
Since Rick hasn't responded, and I need a shot at redemption after not looking closely at what my code of post #2 was doing, here's some code to address your Scenario #2 from post #9 . I have altered the output to limit the count of consecutive cells to the max value and the sum to the max value where there are rows with more than one area meeting the max count. Data from a portion of your post #9 , Scenario2 layout, as produced by the code, are shown below the code.
Code: 
Sub Kishan()
Dim R As Range, i As Long, j As Long, k As Long, Vin As Variant, RTemp As Range

Application.ScreenUpdating = True
End Sub
Click to expand...
Hi JoeMo, I change background colours $ font white. Code is perfect, highlighting the same counts and giving a sum for maximum sequence.

Results output...


Book1
ABCDEFGHIJKLMNOPQRST
1
2
3
4
5
6P1P2P3P4P5P6P7P8P9P10P11P12P13P14Count1Sum Max
7X111121X21X2X267
8122222X222222X612
921X11X1211XXX145
19X111222X12X11169
20X1112XX11X111145
211121221X2121XX710
26211XX2212111X2710
2712X1X1XX1X11XX23
28111XX11X121X1134
2922211X11221111810
30X212122X212121610
3121211X2XXX221257
321X1XX12212112X812
3311X11121X1111156
41X1212212112X111015
432X212XX122XXXX35
4422XX1X11111X1X55
472X22111X1111X157
4812X22212X1112159
49
50
51
Sheet5-4-1


Thank you very much for your kind help

Have a nice day

Good Luck

Kind regards,
Kishan :)
 
Last edited:
Upvote 0
Rick Rothstein said:
Thanks for the reminder Joe... I had lost track of this thread. Here is my code to handle Scenario 2. Note that all you need to provide is the table in Columns C thru P... the code will draw the summary data in Column S thru Z (same output layout as was used for Scenario 1).
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub LongestConsecutiveSequence2()
  Dim R As Long, X As Long, Z As Long, MaxLen As Long, Last As Long, 
  Application.ScreenUpdating = True
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
Hi Rick, I change font white, code is perfect highlighting the same counts and giving a sum for all sequences I like the idea.

Results output...


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
4
5
6P1P2P3P4P5P6P7P8P9P10P11P12P13P14CountSum1Sum2Sum3Sum4Sum5Sum6Sum7
7X111121X21X2X267
8122222X222222X61112
18122X121121X11168
19X111222X12X11169
20X1112XX11X1111454
211121221X2121XX710
2922211X11221111810
30X212122X2121216109
3121211X2XXX221257
41X1212212112X111015
42XX1222111X211X710
472X22111X1111X157
4812X22212X11121596
491X2X1X1X2X1X2X11211212
50
51
Sheet5-4-2


Thank you very much for your kind help

Have a nice day

Good Luck

Kind regards,
Kishan :)
 
Last edited:
Upvote 0
Kishan said:
Hi Rick, I change font white, code is perfect highlighting the same counts and giving a sum for all sequences I like the idea.
Click to expand...
Sorry, I had meant to go back before I posted my code and add code to change the font to white, but I forgot to do so.:oops: I am glad you were able to find the right spot in my code and make the change on your own.



Kishan said:
Thank you very much for your kind help
Click to expand...
You are quite welcome. I think I mentioned this on one of your previous questions... I don't know what these 1/2/X codes are meant for, but the various questions you have asked about them through the years almost always yield fun coding challenges for the volunteers here (personally, I really like coding challenges), so I am glad you have chosen the MrExcel forum to ask your questions at.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Complicate highlight between 2 ranges (27 unique combinations Vs 12 results)
Replies
7
Views
307
motilulla
M
M
  • Solved
Highlight in the row range duplicate respects to previous row
Replies
3
Views
287
etaf
etaf
A
  • Question
formula help please: to return MAX number of consecutive 1's in column when the table filtered
Replies
4
Views
556
DanteAmor
DanteAmor
M
  • Solved
Count consecutive number with largest value and sum this
2
Replies
16
Views
999
meohen1992
M
J
  • Question
How to: sum if only the most recent consecutive numbers in cells of same column appear.
Replies
5
Views
612
Josean
J

Forum statistics

Threads
1,214,790
Messages
6,121,608
Members
449,038
Latest member
apwr

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top