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

[Kishan]

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	Before "X" 11th Position	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	1	1	X	1	1	1	2	X	1	1
4	2013	02/12/2013	2	2	X	1	2	1	X	X	2	1	2	1	2	X
5	2013	03/12/2013	1	1	1	1	1	X	1	X	1	1	X	X	1	2		2
6	2013	04/12/2013	1	1	1	2	1	1	1	2	X	1	1	1	X	1
7	2013	05/12/2013	1	X	1	1	X	1	2	X	1	1	1	1	1	X
8	2013	06/12/2013	1	1	1	2	2	X	1	1	1	X	1	1	1	X
9	2013	07/12/2013	1	1	X	1	1	1	1	2	1	X	1	1	X	1
10	2013	08/12/2013	1	2	1	1	1	1	2	1	1	X	1	1	1	2
11	2013	09/12/2013	2	2	X	2	1	1	2	X	2	1	1	X	1	2
12	2013	10/12/2013	1	1	1	X	1	2	2	1	1	2	1	X	1	1
13	2013	11/12/2013	1	2	1	1	X	1	1	1	1	X	X	1	X	X			1
14	2013	12/12/2013	1	1	2	X	2	2	1	2	X	1	1	X	2	1
15	2013	13/12/2013	1	X	1	X	1	2	2	2	1	1	1	2	2	2
16	2013	14/12/2013	X	X	1	1	2	1	1	2	2	2	X	1	1	1				3
17	2013	15/12/2013	2	2	2	2	2	X	1	1	1	2	X	2	X	1				1
18	2013	16/12/2013	X	1	1	1	X	X	X	1	1	1	X	1	2	2		3
19	2013	17/12/2013	2	2	X	1	2	1	2	1	2	1	X	1	1	X		1
20	2013	18/12/2013	X	1	1	2	1	1	2	1	X	2	X	2	2	1				1
21	2013	19/12/2013	1	1	1	2	1	2	X	2	2	X	1	2	1	1
22	2013	20/12/2013	2	1	1	1	X	2	1	1	X	1	1	1	2	2
Count 1-X-2 Before "X" 11th Pos

Need VBA solution if possible

Please help!

Thanks

Regards,
Kishan

 

[onlyadrafter]

Hello,

sorry, rushing too much

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]

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	Before "X" 11th Position	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	Before "X" 11th Position	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]

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

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

 

[Kishan]

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]

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...

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

 

[Kishan]

Sorry, I forgot to do that. Here is revised code which should do it all for you...

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

<tbody> </tbody>

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]

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]

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]

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	Before "1" 11th Position	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	1	1	X	1	1	1	2	X	1	1
4	2013	02/12/2013	2	2	X	1	2	1	X	X	2	1	2	1	2	X
5	2013	03/12/2013	1	1	1	1	1	X	1	X	1	1	X	X	1	2
6	2013	04/12/2013	1	1	1	2	1	1	1	2	X	1	1	1	X	1		1
7	2013	05/12/2013	1	X	1	1	X	1	2	X	1	1	1	1	1	X		2
8	2013	06/12/2013	1	1	1	2	2	X	1	1	1	X	1	1	1	X			1
9	2013	07/12/2013	1	1	X	1	1	1	1	2	1	X	1	1	X	1			1
10	2013	08/12/2013	1	2	1	1	1	1	2	1	1	X	1	1	1	2			1
11	2013	09/12/2013	2	2	X	2	1	1	2	X	2	1	1	X	1	2				1
12	2013	10/12/2013	1	1	1	X	1	2	2	1	1	2	1	X	1	1
13	2013	11/12/2013	1	2	1	1	X	1	1	1	1	X	X	1	X	X
14	2013	12/12/2013	1	1	2	X	2	2	1	2	X	1	1	X	2	1		1
15	2013	13/12/2013	1	X	1	X	1	2	2	2	1	1	1	2	2	2		2
16	2013	14/12/2013	X	X	1	1	2	1	1	2	2	2	X	1	1	1
17	2013	15/12/2013	2	2	2	2	2	X	1	1	1	2	X	2	X	1
18	2013	16/12/2013	X	1	1	1	X	X	X	1	1	1	X	1	2	2
19	2013	17/12/2013	2	2	X	1	2	1	2	1	2	1	X	1	1	X
20	2013	18/12/2013	X	1	1	2	1	1	2	1	X	2	X	2	2	1
21	2013	19/12/2013	1	1	1	2	1	2	X	2	2	X	1	2	1	1			1
22	2013	20/12/2013	2	1	1	1	X	2	1	1	X	1	1	1	2	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	Before "2" 11th Position	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	1	1	X	1	1	1	2	X	1	1		3
4	2013	02/12/2013	2	2	X	1	2	1	X	X	2	1	2	1	2	X		1
5	2013	03/12/2013	1	1	1	1	1	X	1	X	1	1	X	X	1	2
6	2013	04/12/2013	1	1	1	2	1	1	1	2	X	1	1	1	X	1
7	2013	05/12/2013	1	X	1	1	X	1	2	X	1	1	1	1	1	X
8	2013	06/12/2013	1	1	1	2	2	X	1	1	1	X	1	1	1	X
9	2013	07/12/2013	1	1	X	1	1	1	1	2	1	X	1	1	X	1
10	2013	08/12/2013	1	2	1	1	1	1	2	1	1	X	1	1	1	2
11	2013	09/12/2013	2	2	X	2	1	1	2	X	2	1	1	X	1	2
12	2013	10/12/2013	1	1	1	X	1	2	2	1	1	2	1	X	1	1
13	2013	11/12/2013	1	2	1	1	X	1	1	1	1	X	X	1	X	X
14	2013	12/12/2013	1	1	2	X	2	2	1	2	X	1	1	X	2	1
15	2013	13/12/2013	1	X	1	X	1	2	2	2	1	1	1	2	2	2
16	2013	14/12/2013	X	X	1	1	2	1	1	2	2	2	X	1	1	1
17	2013	15/12/2013	2	2	2	2	2	X	1	1	1	2	X	2	X	1
18	2013	16/12/2013	X	1	1	1	X	X	X	1	1	1	X	1	2	2
19	2013	17/12/2013	2	2	X	1	2	1	2	1	2	1	X	1	1	X
20	2013	18/12/2013	X	1	1	2	1	1	2	1	X	2	X	2	2	1
21	2013	19/12/2013	1	1	1	2	1	2	X	2	2	X	1	2	1	1
22	2013	20/12/2013	2	1	1	1	X	2	1	1	X	1	1	1	2	2
Count 1-X-2 Before "2" 11th Pos

Regards,
Kishan

<colgroup><col><col><col span="9"><col span="5"><col><col span="3"></colgroup><tbody>
</tbody>

 

[Rick Rothstein]

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.

[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]