Count 1st character max occurrences as long as it find

Kishan · Jul 2, 2019

Using Excel 2000
Hi,

My data are in the column C:P, require results in the Column R:T

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

Example data....

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

1

2

3

4

5

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

1

X

2

6

X

1

2

1

2

1

2

X

1

X

1

7

X

2

1

X

1

2

1

X

2

1

2

8

1

2

X

1

X

1

8

9

2

1

X

1

2

1

5

10

1

X

1

X

1

2

1

X

1

11

X

2

X

2

X

1

2

1

2

1

12

X

1

2

1

2

1

X

1

X

1

13

1

X

2

1

X

1

2

1

X

1

14

1

2

X

1

X

1

X

3

15

1

X

1

X

1

2

X

1

16

X

1

X

2

1

2

X

1

X

1

17

1

X

1

2

1

X

1

2

1

X

1

2

18

1

X

1

2

X

1

5

19

X

1

X

11

20

1

2

1

X

1

2

X

1

X

2

4

21

1

2

1

X

1

2

1

X

1

3

22

2

1

X

1

X

1

2

1

2

1

23

1

X

1

11

24

X

1

2

1

2

1

X

1

X

1

25

1

X

1

4

26

X

1

2

1

X

1

X

1

27

1

2

X

1

2

1

X

1

28

1

2

1

2

X

1

X

1

X

3

29

1

X

1

2

1

X

2

8

30

1

X

1

X

1

X

1

2

3

31

1

X

1

3

32

1

X

1

2

1

X

1

X

2

1

33

2

1

X

1

X

2

1

2

1

X

1

2

34

1

X

1

2

1

X

1

X

1

35

2

1

2

X

1

X

1

X

1

3

36

1

X

2

1

2

X

1

X

1

2

X

1

37

X

1

2

X

1

38

X

2

1

X

1

2

X

1

39

X

1

2

1

2

1

X

1

2

1

40

1

X

1

2

X

1

2

1

X

1

3

41

X

1

X

1

X

1

3

42

2

X

2

1

X

1

X

1

X

1

2

1

43

X

1

2

X

1

2

1

2

1

2

44

X

1

X

1

X

1

2

1

X

2

45

1

X

1

2

1

X

1

2

46

1

X

2

1

X

1

4

47

48

49

Sheet3

Thank you in advance

Regards,
Kishan

Rick Rothstein · Jul 2, 2019

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

Marcelo Branco · Jul 2, 2019

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

M.

Marcelo Branco · Jul 2, 2019

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.

Kishan · Jul 2, 2019

Rick Rothstein said:

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

Thank you so much for your kind help

Kind Regards,
Kishan

Kishan · Jul 2, 2019

Marcelo Branco said:
Formula in R6 copied across and down
=IF(R$5<>$C6,"",MATCH(1,INDEX(--($C6:$P6<>$C6),),0)-1)

M.

Marcelo Branco said:
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 "IFERROR" so did not worked with my version,

Thank you so much for your help 

Kind Regards,
Kishan

Kishan · Jul 3, 2019

Rick Rothstein said:
Give this macro a try...

Hi, would it be possible to get fill zero in the blank cells columns R:T? 

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

Thank you in advance

Kind Regards,
Kishan

Rick Rothstein · Jul 3, 2019

Kishan said:
Hi, would it be possible to get fill zero in the blank cells columns R:T? 

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

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

Kishan · Jul 3, 2019

Rick Rothstein said:

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

Rick Rothstein said:
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

Rick Rothstein said:
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

Rick Rothstein said:
Here is my code revised to do these...

I appreciate your time and help twice, modifying macro as per second request. It worked fine

Have a nice day 

Kind Regards,
Kishan

Count 1st character max occurrences as long as it find

Kishan

Well-known Member

Excel Facts

Rick Rothstein

MrExcel MVP

Marcelo Branco

MrExcel MVP

Marcelo Branco

MrExcel MVP

Kishan

Well-known Member

Kishan

Well-known Member

Kishan

Well-known Member

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Similar threads

Forum statistics

Share this page

Count 1st character max occurrences as long as it find

Well-known Member

Excel Facts

MrExcel MVP

MrExcel MVP

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP

Well-known 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