Count 1st character max occurrences as long as it find

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,645
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000</SPAN></SPAN>
Hi,</SPAN></SPAN>

My data are in the column C:P, require results in the Column R:T</SPAN></SPAN>

For example count max occurrences of the 1st character find in the each row</SPAN></SPAN>
Row 6 1st character X max occurrence=1, result In S6=1</SPAN></SPAN>
Row 7 1st character X max occurrence=2, result In S7=2</SPAN></SPAN>
Row 8 1st character 1 max occurrence=8, result In R8=8</SPAN></SPAN>
Row 9 1st character 2 max occurrence=5, result In T9=5,and so on... </SPAN></SPAN>

Example data....</SPAN></SPAN>


Book1
ABCDEFGHIJKLMNOPQRSTUV
1
2
3
4
5P1P2P3P4P5P6P7P8P9P10P11P12P13P141X2
6X11121212X11X11
7XX21XX1121X2112
8111111112X11X18
9222221X11221115
101X1X11211XXX111
11X2XX2X112111121
12X112111211X1X11
131XX21X111211X11
141112XXX1XX1XXX3
151XX11111X112X11
16X1X212XXX111XX1
1711X121X11121X12
1811111X11122X115
19XXXXXXXXXXX1XX11
20111121XX12X1X24
211112211X1211X13
2221X11X111211121
2311111111111XX111
24X11211211X111X1
251111X1111111114
26X1111211XX11X11
2712XXXX12111X111
28111212XXXX1X1X3
2911111111X121X28
30111X111X11X1123
31111X11111111113
321X11211XXX1X211
332211X1X21221X12
341X12111111X1X11
3522212X1XX11XX13
361XX2112X11X12X1
37X111111112XXXX1
38X211XX1112X1111
39X12121XXXXX1121
40111XX12X121XX13
41XXX11X1111XX113
422X21X1X11X12211
43XX12X1211111212
44XX1X1111X1211X2
4511X11211111X112
461111X2211111X14
47
48
49
Sheet3


Thank you in advance</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>
 
Last edited:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Give this macro a try...
Code:
Sub ConsecutiveCountForFirstCharacter()
  Dim R As Long, C As Long, Cnt As Long, Chars As Variant
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    Chars = Cells(R, "C").Resize(, 14)
    Cnt = 0
    For C = 1 To UBound(Chars, 2)
      If Cells(R, C + 2).Value = Cells(R, "C").Value Then
        Cnt = Cnt + 1
      Else
        Exit For
      End If
    Next
    Cells(R, "Q").Offset(, InStr(1, "1X2", Cells(R, "C").Value, vbTextCompare)) = Cnt
  Next
End Sub
 
Upvote 0
Formula in R6 copied across and down
=IF(R$5<>$C6,"",MATCH(1,INDEX(--($C6:$P6<>$C6),),0)-1)

M.
 
Upvote 0
A small adjustment to handle the case when all values in C:P are the same.

R6 copied across and down
=IF(R$5<>$C6,"",IFERROR(MATCH(1,INDEX(--($C6:$P6<>$C6),),0)-1,COLUMNS($C6:$P6)))

M.
 
Upvote 0
Give this macro a try...
Code:
Sub ConsecutiveCountForFirstCharacter()
  Dim R As Long, C As Long, Cnt As Long, Chars As Variant
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    Chars = Cells(R, "C").Resize(, 14)
    Cnt = 0
    For C = 1 To UBound(Chars, 2)
      If Cells(R, C + 2).Value = Cells(R, "C").Value Then
        Cnt = Cnt + 1
      Else
        Exit For
      End If
    Next
    Cells(R, "Q").Offset(, InStr(1, "1X2", Cells(R, "C").Value, vbTextCompare)) = Cnt
  Next
End Sub
Hi Rick, much kind of you macro worked fine</SPAN></SPAN>

Thank you so much for your kind help

Kind Regards,
</SPAN></SPAN>
Kishan
:)</SPAN></SPAN>
 
Upvote 0
Formula in R6 copied across and down
=IF(R$5<>$C6,"",MATCH(1,INDEX(--($C6:$P6<>$C6),),0)-1)

M.


A small adjustment to handle the case when all values in C:P are the same.

R6 copied across and down
=IF(R$5<>$C6,"",IFERROR(MATCH(1,INDEX(--($C6:$P6<>$C6),),0)-1,COLUMNS($C6:$P6)))

M.
Hi Marcelo, indeed formula post#3 worked fine, and post#4 formula use function </SPAN></SPAN>"IFERROR" so did not worked with my version,</SPAN></SPAN>

Thank you so much for your help
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan
:)</SPAN></SPAN>
 
Upvote 0
Give this macro a try...
Hi, would it be possible to get fill zero in the blank cells columns R:T? </SPAN>

Please also need a macro that can highlight the continuous occurrence of data in the column C:P as per post#1 shown, 1 with red fill X with green fill and 2 with blue fill</SPAN></SPAN>

Thank you in advance</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN></SPAN>
 
Upvote 0
Hi, would it be possible to get fill zero in the blank cells columns R:T? </SPAN>

Please also need a macro that can highlight the continuous occurrence of data in the column C:P as per post#1 shown, 1 with red fill X with green fill and 2 with blue fill</SPAN></SPAN>
Your original post did not show zeros, so I did not program them in. As for the colors... I wasn't sure about your wanting them or not. Here is my code revised to do these...
Code:
Sub ConsecutiveCountForFirstCharacter()
  Dim R As Long, C As Long, Cnt As Long, Chars As Variant
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    Chars = Cells(R, "C").Resize(, 14)
    Cnt = 0
    For C = 1 To UBound(Chars, 2)
      If Cells(R, C + 2).Value = Cells(R, "C").Value Then
        Cnt = Cnt + 1
      Else
        Exit For
      End If
    Next
    Cells(R, "R").Resize(, 3) = 0
    With Cells(R, "Q").Offset(, InStr(1, "1X2", Cells(R, "C").Value, vbTextCompare))
      .Value = Cnt
      .Interior.Color = Choose(InStr(1, "1X2", Cells(R, "C").Value), vbRed, 5287936, vbBlue)
      .Font.Color = vbWhite
    End With
    With Cells(R, "C").Resize(, Cnt)
      .Interior.Color = Choose(InStr(1, "1X2", Cells(R, "C").Value), vbRed, 5287936, vbBlue)
      .Font.Color = vbWhite
    End With
  Next
End Sub
 
Last edited:
Upvote 0
Your original post did not show zeros, so I did not program them in. As for the colors... I wasn't sure about your wanting them or not. Here is my code revised to do these...
Code:
Sub ConsecutiveCountForFirstCharacter()
  Dim R As Long, C As Long, Cnt As Long, Chars As Variant
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    Chars = Cells(R, "C").Resize(, 14)
    Cnt = 0
    For C = 1 To UBound(Chars, 2)
      If Cells(R, C + 2).Value = Cells(R, "C").Value Then
        Cnt = Cnt + 1
      Else
        Exit For
      End If
    Next
    Cells(R, "R").Resize(, 3) = 0
    With Cells(R, "Q").Offset(, InStr(1, "1X2", Cells(R, "C").Value, vbTextCompare))
      .Value = Cnt
      .Interior.Color = Choose(InStr(1, "1X2", Cells(R, "C").Value), vbRed, 5287936, vbBlue)
      .Font.Color = vbWhite
    End With
    With Cells(R, "C").Resize(, Cnt)
      .Interior.Color = Choose(InStr(1, "1X2", Cells(R, "C").Value), vbRed, 5287936, vbBlue)
      .Font.Color = vbWhite
    End With
  Next
End Sub
Your original post did not show zeros, so I did not program them in.
Hi Rick, sorry, that I thought after I run your code that is why this were not mentioned in post#1 </SPAN></SPAN>

As for the colors... I wasn't sure about your wanting them or not.
Sincerely I were not waiting neither I thought it before this idea also come later


Here is my code revised to do these...
I appreciate your time and help twice, modifying macro as per second request. It worked fine</SPAN></SPAN>

Have a nice day
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>:)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

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