Highlight Columns- Highlight count series of max frequency consecutive positive numbers

M

mr_king

New Member
Joined
May 18, 2018
Messages
15
[FONT=&quot]Hello,[/FONT]
[FONT=&quot]I'm Looking for an excel Formula or VBA code to color (highlight or background fill) columns based on the count series of max frequency consecutive positive numbers. It should be left open ended for more data to be added after column P and Lower than row 5.[/FONT]
[FONT=&quot]
79004872-681f-4ded-805e-96431fa4f75b
832dd83d-9b46-4ce6-be95-73a048b48e70
[/FONT]
[FONT=&quot]Rows described:[/FONT]
[FONT=&quot]1. max positive count is 4 highlighted, sum is 17 [/FONT]
[FONT=&quot]2 max positive count is 5 highlighted, sum is 19[/FONT]
[FONT=&quot]3. max positive count is 8 highlighted, sum is 30
4. max positive count is 6 highlighted, sum is 14
5. max positive count is 2 highlighted, sum is 11
[/FONT]
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG18May19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Rr [COLOR="Navy"]As[/COLOR] Range, sR [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = ActiveSheet.Cells(1).CurrentRegion
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Rows
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn.Cells
        [COLOR="Navy"]If[/COLOR] R.Value > 0 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = R Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, R)
         [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rr [COLOR="Navy"]In[/COLOR] nRng.Areas
            [COLOR="Navy"]If[/COLOR] Application.Sum(Rr) > oMax [COLOR="Navy"]Then[/COLOR]
             oMax = Application.Sum(Rr)
             [COLOR="Navy"]Set[/COLOR] sR = Rr
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Next[/COLOR] Rr
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] Not sR [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] sR.Interior.Color = vbYellow
[COLOR="Navy"]Set[/COLOR] nRng = Nothing: [COLOR="Navy"]Set[/COLOR] sR = Nothing: oMax = 0
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
This code is with added range Addresses and sums on sheet2.

Code: 
[COLOR=navy]Sub[/COLOR] MG18May20
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, R [COLOR=navy]As[/COLOR] Range, Rr [COLOR=navy]As[/COLOR] Range, sR [COLOR=navy]As[/COLOR] Range, nRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = ActiveSheet.Cells(1).CurrentRegion
ReDim ray(1 To Rng.Count, 1 To 2)
c = 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng.Rows
      [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dn.Cells
        [COLOR=navy]If[/COLOR] R.Value > 0 [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] [COLOR=navy]Set[/COLOR] nRng = R Else [COLOR=navy]Set[/COLOR] nRng = Union(nRng, R)
         [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] R
[COLOR=navy]
If[/COLOR] Not nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
      [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Rr [COLOR=navy]In[/COLOR] nRng.Areas
            [COLOR=navy]If[/COLOR] Application.Sum(Rr) > oMax [COLOR=navy]Then[/COLOR]
             oMax = Application.Sum(Rr)
             [COLOR=navy]Set[/COLOR] sR = Rr
            [COLOR=navy]End[/COLOR] If
      [COLOR=navy]Next[/COLOR] Rr
[COLOR=navy]End[/COLOR] If
[COLOR=navy]
If[/COLOR] Not sR [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
    sR.Interior.Color = vbYellow
    c = c + 1
    ray(c, 1) = sR.Address: ray(c, 2) = Application.Sum(sR)
    [COLOR=navy]Set[/COLOR] nRng = Nothing: [COLOR=navy]Set[/COLOR] sR = Nothing: oMax = 0
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn

ray(1, 1) = "Address": ray(1, 2) = "Sum of values"
[COLOR=navy]
With[/COLOR] Sheets("sheet2").Range("A1").Resize(c, 2)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Big Thank you :) The code works great.

If I wanted it to start in cell F20 instead of A1, how would I modify the vba to that cell?


Thanks!
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG19May06
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Rr [COLOR="Navy"]As[/COLOR] Range, sR [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Cells("20", Columns.Count).End(xlToLeft).Column - 4
[COLOR="Navy"]Set[/COLOR] Rng = Range("F20", Range("F" & Rows.Count).End(xlUp)).Resize(, Lst)
ReDim ray(1 To Rng.Count, 1 To 2)
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Rows
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn.Cells
        [COLOR="Navy"]If[/COLOR] R.Value > 0 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = R Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, R)
         [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rr [COLOR="Navy"]In[/COLOR] nRng.Areas
            [COLOR="Navy"]If[/COLOR] Application.Sum(Rr) > oMax [COLOR="Navy"]Then[/COLOR]
             oMax = Application.Sum(Rr)
             [COLOR="Navy"]Set[/COLOR] sR = Rr
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Next[/COLOR] Rr
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] Not sR [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    sR.Interior.Color = vbYellow
    c = c + 1
    ray(c, 1) = sR.Address: ray(c, 2) = Application.Sum(sR)
    [COLOR="Navy"]Set[/COLOR] nRng = Nothing: [COLOR="Navy"]Set[/COLOR] sR = Nothing: oMax = 0
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
ray(1, 1) = "Address": ray(1, 2) = "Sum of values"
[COLOR="Navy"]With[/COLOR] Sheets("sheet2").Range("A1").Resize(c, 2)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG thanks for your assistance. I really appreciate it.

I think we are almost there. I noticed an issue with the logic of the vba coding when adding additional numbers, as seen below in the red outlined cells.

The current VBA code is highlighting in yellow- the max subtotal of consecutive positives, instead of the max count of consecutive positives. The red outlined are a few examples of what I'm looking to see applied instead.


9
2qwhtaq.jpg



Row 1: max count consecutive positives is 5, subtotal is 6 (as seen in outlined red)
Row 2: max count consecutive positives is 5, subtotal is 19.
Row 3: max count consecutive positives is 6, subtotal is 29.
Row 4: max count consecutive positives is 6, subtotal is 14. (as seen in outlined red)
Row 5: max count consecutive positives is 3, subtotal is 4. (as seen in outlined red)


Thanks! :)
 
Upvote 0
Try changing code in red:-
Code: 
If Not sR Is Nothing Then
    sR.Interior.Color = vbYellow
    c = c + 1
    Ray(c, 1) = sR.Address: Ray(c, 2) =[B][COLOR=#FF0000] sR.Count            [/COLOR][/B][COLOR=#000000]'Was :[/COLOR]- Application.Sum(sR)
    Set nRng = Nothing: Set sR = Nothing: oMax = 0
End If
Next Dn
Ray(1, 1) = "Address": Ray(1, 2) = "[B][COLOR=#FF0000]Count [/COLOR][/B]of values"
With Sheets("sheet2").Range("A1").Resize(c, 2)
  [B][COLOR=#FF0000]  .Parent.Columns("A:B").ClearContents[/COLOR][/B]
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
End With
 
Upvote 0
Are you sure ????
This is your original date:-

This is your Basic data starting "F20"
[TABLE="width: 816"]
<colgroup><col width="68" style="width: 51pt; mso-width-source: userset; mso-width-alt: 2417;" span="16"> <tbody>[TR]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-2[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-3[/TD]
[TD="class: xl66, width: 68, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, width: 68, bgcolor: yellow, align: right"]3[/TD]
[TD="class: xl66, width: 68, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, width: 68, bgcolor: yellow, align: right"]8[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-3[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]-1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]2[/TD]
[TD="class: xl65, width: 68, bgcolor: transparent, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]11[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]2[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]2[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]4[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]6[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-2[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]4[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]9[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[/TR]
[TR]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]6[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]7[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]8[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]5[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]7[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]8[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-8[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3[/TD]
[TD="class: xl65, bgcolor: transparent"] [/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-4[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-3[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-7[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-4[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]6[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]1[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]-[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-2[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]5[/TD]
[TD="class: xl66, bgcolor: yellow, align: right"]6[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]-4[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]7[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1[/TD]
[/TR]
</tbody>[/TABLE]





This is the results From Original Code
[TABLE="width: 138"]
<tbody>[TR]
[TD="class: xl65, width: 86, bgcolor: transparent"]Address
[/TD]
[TD="class: xl65, width: 99, bgcolor: transparent"] Sum of values
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$I$20:$L$20
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]17
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$K$21:$O$21
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]19
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$F$22:$L$22
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]29
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$P$23:$U$23
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]14
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$I$24:$J$24
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]11
[/TD]
[/TR]
</tbody>[/TABLE]

Here is the result from Latest code:-
[TABLE="width: 156"]
<tbody>[TR]
[TD="class: xl65, width: 86, bgcolor: transparent"]Address
[/TD]
[TD="class: xl65, width: 123, bgcolor: transparent"]Count of values
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$I$20:$L$20
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]4
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$K$21:$O$21
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]5
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$F$22:$L$22
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]7
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$P$23:$U$23
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]6
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]$I$24:$J$24
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2
[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
The VBA works correctly with the original data set. However, when adding/changing the data as seen below, it is not functioning to my desired needs.


The below is the results of the VBA code you provided: As you can see in the below rows 20, 23 & 24 the vba is not correctly highlighting the max count of consecutive positives. The count on sheet2 is not either.

2lmp2xh.jpg
[/IMG]


Current Sheet2 output:

[TABLE="width: 0"]
<tbody>[TR]
[TD]Address
[/TD]
[TD]Count of values
[/TD]
[/TR]
[TR]
[TD]$I$20:$L$20
[/TD]
[TD]4
[/TD]
[/TR]
[TR]
[TD]$K$21:$O$21
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]$P$22:$U$22
[/TD]
[TD]6
[/TD]
[/TR]
[TR]
[TD]$F$23:$G$23
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]$I$24:$J$24
[/TD]
[TD]2
[/TD]
[/TR]
</tbody>[/TABLE]


Current VBA used that you provided:

Code: 
Sub MG19May06()
Dim Rng As Range, Dn As Range, R As Range, Rr As Range, sR As Range, nRng As Range
Dim oMax As Long, c As Long
Dim Lst As Long
Lst = Cells("20", Columns.Count).End(xlToLeft).Column - 4
Set Rng = Range("F20", Range("F" & Rows.Count).End(xlUp)).Resize(, Lst)
ReDim ray(1 To Rng.Count, 1 To 2)
c = 1
For Each Dn In Rng.Rows
      For Each R In Dn.Cells
        If R.Value > 0 Then
            If nRng Is Nothing Then Set nRng = R Else Set nRng = Union(nRng, R)
         End If
Next R
If Not nRng Is Nothing Then
      For Each Rr In nRng.Areas
            If Application.Sum(Rr) > oMax Then
             oMax = Application.Sum(Rr)
             Set sR = Rr
            End If
      Next Rr
End If
If Not sR Is Nothing Then
    sR.Interior.Color = vbYellow
    c = c + 1
    ray(c, 1) = sR.Address: ray(c, 2) = sR.Count            'Was :- Application.Sum(sR)
    Set nRng = Nothing: Set sR = Nothing: oMax = 0
End If
Next Dn
ray(1, 1) = "Address": ray(1, 2) = "Count of values"
With Sheets("sheet2").Range("A1").Resize(c, 2)
    .Parent.Columns("A:B").ClearContents
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
End With
End Sub



**Below are the results that I'm looking to see from the VBA code: Highlighting the max count of consecutive positives for each row (left open ended for more data to be added on rows & columns). The VBA should be able to correctly identifying & highlight the max count based on any figures entered for each row.

Desired output from example data provided:

142yd8x.jpg
[/IMG]


Desired Sheet2 results:
[TABLE="width: 0"]
<tbody>[TR]
[TD]Address
[/TD]
[TD]Count of values
[/TD]
[/TR]
[TR]
[TD]$Q$20:$U$20
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]$K$21:$O$21
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]$P$22:$U$22
[/TD]
[TD]6
[/TD]
[/TR]
[TR]
[TD]$P$23:$U$23
[/TD]
[TD]6
[/TD]
[/TR]
[TR]
[TD]$M$24:$O$24
[/TD]
[TD]3
[/TD]
[/TR]
</tbody>[/TABLE]






Thanks for your help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Counting Consecutive Blanks
Replies
9
Views
708
felixstraube
F
R
  • Solved
How to independently sort multiple columns of this SEQUENCE output without effecting the positions of the columns and of the blanks?
2
Replies
15
Views
580
Rnkhch
R
R
  • Question Question
Highlighting cells based on criteria
Replies
0
Views
443
rahildhody
R
W
  • Question Question
Excel VBA - Check For Duplicates and Return the Count on a Large Data Set
Replies
4
Views
403
Kaper
Kaper
R
  • Question Question
How do I rank a table, formula or macro please?
Replies
5
Views
148
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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