Count 1-X-2 Before "X" 11th Pos

Kishan · Sep 12, 2015

Hi,

I need to count in the each row 1, X & 2 before the X is finding in the 11th position (and stop counting if breaks with other sign is found). Example is attached

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

1

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Before "X" 11th Position

2

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Count 1

Count X

Count 2

3

2013

01/12/2013

2

X

2

1

X

1

2

X

1

4

2013

02/12/2013

2

X

1

2

1

X

2

1

2

1

2

X

5

2013

03/12/2013

1

X

1

X

1

X

1

2

6

2013

04/12/2013

1

2

1

2

X

1

X

1

7

2013

05/12/2013

1

X

1

X

1

2

X

1

X

8

2013

06/12/2013

1

2

X

1

X

1

X

9

2013

07/12/2013

1

X

1

2

1

X

1

X

1

10

2013

08/12/2013

1

2

1

2

1

X

1

2

11

2013

09/12/2013

2

X

2

1

2

X

2

1

X

1

2

12

2013

10/12/2013

1

X

1

2

1

2

1

X

1

13

2013

11/12/2013

1

2

1

X

1

X

1

X

1

14

2013

12/12/2013

1

2

X

2

1

2

X

1

X

2

1

15

2013

13/12/2013

1

X

1

X

1

2

1

2

16

2013

14/12/2013

X

1

2

1

2

X

1

3

17

2013

15/12/2013

2

X

1

2

X

2

X

1

18

2013

16/12/2013

X

1

X

1

X

1

2

3

19

2013

17/12/2013

2

X

1

2

1

2

1

2

1

X

1

X

1

20

2013

18/12/2013

X

1

2

1

2

1

X

2

X

2

1

21

2013

19/12/2013

1

2

1

2

X

2

X

1

2

1

22

2013

20/12/2013

2

1

X

2

1

X

1

2

Count 1-X-2 Before "X" 11th Pos

Need VBA solution if possible

Please help!

Thanks

Regards,
Kishan

onlyadrafter · Sep 12, 2015

Hello,

sorry, rushing too much

Code:

Sub COUNT_COLOUR_1_2_X()
    Columns("C:T").Interior.ColorIndex = xlNone
    MY_POSITION = InputBox("Plase enter X Position", "X POSITION") + 2
    For MY_ROWS = 3 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(MY_ROWS, MY_POSITION).Value = "X" Then
            Cells(MY_ROWS, MY_POSITION).Interior.ColorIndex = 6
            MY_VALUE = Cells(MY_ROWS, MY_POSITION - 1)
            For MY_COLS = MY_POSITION - 1 To 3 Step -1
                If Cells(MY_ROWS, MY_COLS).Value = MY_VALUE Then
                    Select Case MY_VALUE
                        Case 1
                            Cells(MY_ROWS, MY_COLS).Interior.ColorIndex = 3 'red
                        Case "X"
                            Cells(MY_ROWS, MY_COLS).Interior.ColorIndex = 5 'blue
                        Case 2
                            Cells(MY_ROWS, MY_COLS).Interior.ColorIndex = 7
                End Select
                    MY_COUNT = MY_COUNT + 1
                Else
                    GoTo CONT
                End If
            Next MY_COLS
CONT:
            Select Case MY_VALUE
                Case 1
                    Cells(MY_ROWS, 18).Value = MY_COUNT
                    Cells(MY_ROWS, 18).Interior.ColorIndex = 3
                Case "X"
                    Cells(MY_ROWS, 19).Value = MY_COUNT
                    Cells(MY_ROWS, 19).Interior.ColorIndex = 5
                Case 2
                    Cells(MY_ROWS, 20).Value = MY_COUNT
                    Cells(MY_ROWS, 20).Interior.ColorIndex = 7
            End Select
            MY_COUNT = 0
        End If
    Next MY_ROWS
End Sub

Kishan · Sep 12, 2015

onlyadrafter said:
Hello, sorry, rushing too much

Hi onlyadrafter,

1st row 1 and 2 header format should not trun off
2nd counting 1 instance more

Result Requir

Book1

V

W

X

Y

1

Empty

Before "X" 11th Position

2

Empty

Count 1

Count X

Count 2

3

4

5

2

6

7

8

9

10

11

12

13

1

14

15

16

3

17

1

18

3

19

1

20

1

21

22

Count 1-X-2 Before "X" 11th Pos

Getting these results

Book1

R

S

T

1

Before "X" 11th Position

2

Count 1

Count X

Count 2

3

4

5

3

6

7

8

9

10

11

12

13

2

14

15

16

4

17

2

18

4

19

2

20

2

21

22

Count 1-X-2 Before "X" 11th Pos

Please will you take a look?

Thank you

Regards,
Kishan

Rick Rothstein · Sep 12, 2015

Here is another macro that you can consider (it asks you the positions number and handles all the coloring as well)...
[table="width: 500"]
[tr]
[td]

Code:

Sub CountsBeforeXs()
  Dim X As Long, Pos As Long, Count As Long, Cell As Range, Item As String
  Pos = Application.InputBox("Which position number (2 through 14)?", Type:=1)
  If Pos >= 2 And Pos <= 14 Then
    For Each Cell In Range(Cells(3, 2 + Pos), Cells(Rows.Count, 2 + Pos). _
                     End(xlUp)).SpecialCells(xlConstants, xlTextValues)
      Cell.Interior.Color = vbYellow
      Item = Cell.Offset(, -1).Value
      Count = 1
      For X = 2 To Pos - 1
        If Cell.Offset(, -X) = Item Then
          Count = Count + 1
        Else
          Exit For
        End If
      Next
      With Cell.Offset(, 1 - X).Resize(, X - 1)
        .Interior.ColorIndex = InStr("  1 X 2", Item)
        .Font.Color = vbWhite
      End With
      With Intersect(Cell.EntireRow, Columns("Q").Offset(, InStr("1X2", Item)))
        .Value = Count
        .Interior.ColorIndex = Cell.Offset(, -1).Interior.ColorIndex
        .Font.Color = vbWhite
      End With
    Next
  End If
End Sub

[/td]
[/tr]
[/table]

Kishan · Sep 12, 2015

Rick Rothstein said:
Here is another macro that you can consider (it asks you the positions number and handles all the coloring as well)...

Thank you Rick Rothstein, for you kind help it is almost perfect when I run 1^st time and for example input 11 it gives the result correct but when I run 2^nd time and insert 5 it does not clear 1^st once overlap and print also 2^nd result

Please could you check it?

Thank you

Regards,
Kishan

Rick Rothstein · Sep 12, 2015

Kishan said:
Thank you Rick Rothstein, for you kind help it is almost perfect when I run 1^st time and for example input 11 it gives the result correct but when I run 2^nd time and insert 5 it does not clear 1^st once overlap and print also 2^nd result

Sorry, I forgot to do that. Here is revised code which should do it all for you...
[table="width: 500"]
[tr]
[td]

Code:

Sub CountsBeforeXs()
  Dim X As Long, Pos As Long, Count As Long, Cell As Range, Item As String
  Pos = Application.InputBox("Which position number (2 through 14)?", Type:=1)
  If Pos >= 2 And Pos <= 14 Then
    With Range("C3:T" & Cells(Rows.Count, "A").End(xlUp))
      .Interior.ColorIndex = xlColorIndexNone
      .Font.ColorIndex = vbBlack
      Intersect(.Rows, Columns("R:T")).ClearContents
    End With
    For Each Cell In Range(Cells(3, 2 + Pos), Cells(Rows.Count, 2 + Pos). _
                     End(xlUp)).SpecialCells(xlConstants, xlTextValues)
      Cell.Interior.Color = vbYellow
      Item = Cell.Offset(, -1).Value
      Count = 1
      For X = 2 To Pos - 1
        If Cell.Offset(, -X) = Item Then
          Count = Count + 1
        Else
          Exit For
        End If
      Next
      With Cell.Offset(, 1 - X).Resize(, X - 1)
        .Interior.ColorIndex = InStr("  1 X 2", Item)
        .Font.Color = vbWhite
      End With
      With Intersect(Cell.EntireRow, Columns("Q").Offset(, InStr("1X2", Item)))
        .Value = Count
        .Interior.ColorIndex = Cell.Offset(, -1).Interior.ColorIndex
        .Font.Color = vbWhite
      End With
    Next
  End If
End Sub

[/td]
[/tr]
[/table]

Kishan · Sep 12, 2015

Rick Rothstein said:

Sorry, I forgot to do that. Here is revised code which should do it all for you...
[TABLE="width: 500"]
<tbody>[TR]
[TD]

Code:

Sub CountsBeforeXs()
  Dim X As Long, Pos As Long, Count As Long, Cell As Range, Item As String
  Pos = Application.InputBox("Which position number (2 through 14)?", Type:=1)
  If Pos >= 2 And Pos <= 14 Then
    With Range("C3:T" & Cells(Rows.Count, "A").End(xlUp))
      .Interior.ColorIndex = xlColorIndexNone
      .Font.ColorIndex = vbBlack
      Intersect(.Rows, Columns("R:T")).ClearContents
    End With
    For Each Cell In Range(Cells(3, 2 + Pos), Cells(Rows.Count, 2 + Pos). _
                     End(xlUp)).SpecialCells(xlConstants, xlTextValues)
      Cell.Interior.Color = vbYellow
      Item = Cell.Offset(, -1).Value
      Count = 1
      For X = 2 To Pos - 1
        If Cell.Offset(, -X) = Item Then
          Count = Count + 1
        Else
          Exit For
        End If
      Next
      With Cell.Offset(, 1 - X).Resize(, X - 1)
        .Interior.ColorIndex = InStr("  1 X 2", Item)
        .Font.Color = vbWhite
      End With
      With Intersect(Cell.EntireRow, Columns("Q").Offset(, InStr("1X2", Item)))
        .Value = Count
        .Interior.ColorIndex = Cell.Offset(, -1).Interior.ColorIndex
        .Font.Color = vbWhite
      End With
    Next
  End If
End Sub

[/TD]
[/TR]
</tbody>[/TABLE]

Thank you Rick Rothstein, finally you nail it now all is working 100% perfect.

Thank you to all, helped in this thread to solve my request

Have a great weekend

Regards,
Kishan

Kishan · Sep 12, 2015

Hi again,

All is working perfect as requested, sorry to bother you all again, just now come in my mind if macro could be modified which can have an option to count “Before1” X & 2 and “Before2” 1 & X will be grateful or other 2 independents macro which can do these jobs too.

Thank you

Regards
Kishan

Rick Rothstein · Sep 12, 2015

Kishan said:
All is working perfect as requested, sorry to bother you all again, just now come in my mind if macro could be modified which can have an option to count “Before1” X & 2 and “Before2” 1 & X will be grateful or other 2 independents macro which can do these jobs too.

Sorry, I do not understand what you are asking for. Can you make a display of data and desired results like you did in Message #1 so I can see what you are trying to do?

Kishan · Sep 12, 2015

Rick Rothstein said:
Sorry, I do not understand what you are asking for. Can you make a display of data and desired results like you did in Message #1 so I can see what you are trying to do?

Sure count result Before1

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

1

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Before "1" 11th Position

2

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Count 1

Count X

Count 2

3

2013

01/12/2013

2

X

2

1

X

1

2

X

1

4

2013

02/12/2013

2

X

1

2

1

X

2

1

2

1

2

X

5

2013

03/12/2013

1

X

1

X

1

X

1

2

6

2013

04/12/2013

1

2

1

2

X

1

X

1

7

2013

05/12/2013

1

X

1

X

1

2

X

1

X

2

8

2013

06/12/2013

1

2

X

1

X

1

X

1

9

2013

07/12/2013

1

X

1

2

1

X

1

X

1

10

2013

08/12/2013

1

2

1

2

1

X

1

2

1

11

2013

09/12/2013

2

X

2

1

2

X

2

1

X

1

2

1

12

2013

10/12/2013

1

X

1

2

1

2

1

X

1

13

2013

11/12/2013

1

2

1

X

1

X

1

X

14

2013

12/12/2013

1

2

X

2

1

2

X

1

X

2

1

15

2013

13/12/2013

1

X

1

X

1

2

1

2

16

2013

14/12/2013

X

1

2

1

2

X

1

17

2013

15/12/2013

2

X

1

2

X

2

X

1

18

2013

16/12/2013

X

1

X

1

X

1

2

19

2013

17/12/2013

2

X

1

2

1

2

1

2

1

X

1

X

20

2013

18/12/2013

X

1

2

1

2

1

X

2

X

2

1

21

2013

19/12/2013

1

2

1

2

X

2

X

1

2

1

22

2013

20/12/2013

2

1

X

2

1

X

1

2

1

Count 1-X-2 Before "1" 11th Pos

Sure count Result Before2

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

1

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Before "2" 11th Position

2

Year

Date

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Empty

Count 1

Count X

Count 2

3

2013

01/12/2013

2

X

2

1

X

1

2

X

1

3

4

2013

02/12/2013

2

X

1

2

1

X

2

1

2

1

2

X

1

5

2013

03/12/2013

1

X

1

X

1

X

1

2

6

2013

04/12/2013

1

2

1

2

X

1

X

1

7

2013

05/12/2013

1

X

1

X

1

2

X

1

X

8

2013

06/12/2013

1

2

X

1

X

1

X

9

2013

07/12/2013

1

X

1

2

1

X

1

X

1

10

2013

08/12/2013

1

2

1

2

1

X

1

2

11

2013

09/12/2013

2

X

2

1

2

X

2

1

X

1

2

12

2013

10/12/2013

1

X

1

2

1

2

1

X

1

13

2013

11/12/2013

1

2

1

X

1

X

1

X

14

2013

12/12/2013

1

2

X

2

1

2

X

1

X

2

1

15

2013

13/12/2013

1

X

1

X

1

2

1

2

16

2013

14/12/2013

X

1

2

1

2

X

1

17

2013

15/12/2013

2

X

1

2

X

2

X

1

18

2013

16/12/2013

X

1

X

1

X

1

2

19

2013

17/12/2013

2

X

1

2

1

2

1

2

1

X

1

X

20

2013

18/12/2013

X

1

2

1

2

1

X

2

X

2

1

21

2013

19/12/2013

1

2

1

2

X

2

X

1

2

1

22

2013

20/12/2013

2

1

X

2

1

X

1

2

Count 1-X-2 Before "2" 11th Pos

Regards,
Kishan[TABLE="width: 935"]
<colgroup><col><col><col span="9"><col span="5"><col><col span="3"></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Rick Rothstein · Sep 12, 2015

Oh, okay, I see, you want to be able to specify the character before which to count. The following macro will ask you two questions... the first is the position number (same question as my original code asked) and the second question will ask you for the character in that column to do the analysis for.

Code:

[table="width: 500"]
[tr]
	[td]Sub CountsBeforeCharacters()
  Dim X As Long, Pos As Long, Count As Long, Cell As Range, Item As String, Char As String
  Pos = Application.InputBox("Which position number (2 through 14)?", Type:=1)
  If Pos >= 2 And Pos <= 14 Then
    Char = InputBox("What character do you want to find prior to?")
    If Application.CountIf(Range("C3:P" & Cells(Rows.Count, "A").End(xlUp)), Char) Then
      With Range("C3:T" & Cells(Rows.Count, "A").End(xlUp))
        .Interior.ColorIndex = xlColorIndexNone
        .Font.ColorIndex = vbBlack
        Intersect(.Rows, Columns("R:T")).ClearContents
      End With
      Columns(2 + Pos).Replace Char, "#N/A", xlWhole
      For Each Cell In Columns(2 + Pos).SpecialCells(xlConstants, xlErrors)
        Cell.Interior.Color = vbYellow
        Item = Cell.Offset(, -1).Value
        Count = 1
        For X = 2 To Pos - 1
          If Cell.Offset(, -X) = Item Then
            Count = Count + 1
          Else
            Exit For
          End If
        Next
        With Cell.Offset(, 1 - X).Resize(, X - 1)
          .Interior.ColorIndex = InStr("  1 X 2", Item)
          .Font.Color = vbWhite
        End With
        With Intersect(Cell.EntireRow, Columns("Q").Offset(, InStr("1X2", Item)))
          .Value = Count
          .Interior.ColorIndex = Cell.Offset(, -1).Interior.ColorIndex
          .Font.Color = vbWhite
        End With
      Next
      Columns(2 + Pos).Replace "#N/A", Char, xlWhole
    End If
  End If
End Sub[/td]
[/tr]
[/table]

Count 1-X-2 Before "X" 11th Pos

Kishan

Well-known Member

onlyadrafter

Well-known Member

Excel Facts

Kishan

Well-known Member

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Kishan

Well-known Member

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Rick Rothstein

MrExcel MVP

Similar threads

Forum statistics

Share this page

Count 1-X-2 Before "X" 11th Pos

Well-known Member

Well-known Member

Excel Facts

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

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