Creating code to count the matching records in each column

[Brew]

How do I create code for the range DW63:EW116 that will record in each column the count of row(s) that letter “O” between each “H”. Always restart the count with the first “O” match after the “H”. Paste the result in the same cell as the match.
Partial Example:

If DW63:DW85 =, THEN THE UPDATE RESULT SHOULD BE
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,2
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,3
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,2
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,2
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,3
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,4
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,5
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,6
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,2
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1
O,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,2
H,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H

 

[acw]

Hi

Try

Sub aaa()
 Range("dw63").Select
 While Not IsEmpty(ActiveCell)
  If ActiveCell = "0" And ActiveCell.Row = 63 Then ActiveCell = 1
  If ActiveCell = "O" And ActiveCell.Offset(-1, 0) = "H" Then ActiveCell = 1
  If ActiveCell = "O" And IsNumeric(ActiveCell.Offset(-1, 0)) Then ActiveCell = ActiveCell.Offset(-1, 0) + 1
  ActiveCell.Offset(1, 0).Select
  If ActiveCell.Row = 117 Then ActiveCell.Offset(-54, 1).Select
 Wend
End Sub

Tony

 

[Brew]

Wow acw this works, thanks.. It takes a little while to execute, because it changes each cell individually. Its there a way to update this result collectively so that it runs faster. If not, I am satisfied with this result....Thank you

 

[acw]

Hi

Try

Sub bbb()
 For i = 63 To 116
  For j = 127 To 154
   If Cells(i, j) = "O" And j = 63 Then Cells(i, j) = 1
   If Cells(i, j) = "O" And Cells(i - 1, j) = "H" Then Cells(i, j) = 1
   If Cells(i, j) = "O" And IsNumeric(Cells(i - 1, j)) Then Cells(i, j) = Cells(i - 1, j) + 1
  Next j
 Next i
End Sub

Tony

 

[Brew]

acw the 2nd works great as well. both versions executes the update each cell individually. One by column the other by row. With 350MHZ PC, it took about 8 min to run these programs. Can either of these 2 programs be updated to run the function for the entire range together or to a group at a time like an entire row or entire column to change. Maybe this will run faster.

 

[acw]

Hi

The second should have been quite a bit faster than the first as there was no cell selection required.

Maybe add the commands to turn off the calculation before starting and turn it on again at completion.

Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic

Tony

 

[Brew]

Do I try either code like the following:

Sub aaa()
Application.Calculation = xlCalculationManual
Range("dw63").Select
While Not IsEmpty(ActiveCell)
If ActiveCell = "0" And ActiveCell.Row = 63 Then ActiveCell = 1
If ActiveCell = "O" And ActiveCell.Offset(-1, 0) = "H" Then ActiveCell = 1
If ActiveCell = "O" And IsNumeric(ActiveCell.Offset(-1, 0)) Then ActiveCell = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Row = 117 Then ActiveCell.Offset(-54, 1).Select
Wend
Application.Calculation = xlCalculationAutomatic
End Sub

Sub bbb()
Application.Calculation = xlCalculationManual
For i = 63 To 116
For j = 127 To 154
If Cells(i, j) = "O" And j = 63 Then Cells(i, j) = 1
If Cells(i, j) = "O" And Cells(i - 1, j) = "H" Then Cells(i, j) = 1
If Cells(i, j) = "O" And IsNumeric(Cells(i - 1, j)) Then Cells(i, j) = Cells(i - 1, j) + 1
Next j
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

 

[acw]

You got it.


Let me know if that improves things.


Tony

 

[Brew]

Yep! That worked like a champ. Presto! I like it a little better with the 2nd version. Great thanks!!!