vba, countif in a loop.

[montecarlo2012]

Hi.
I founded many examples on how to countif, except this case
I have an array, I would like to find how to COUNT the cells in every column until a color is found and then stop count
The first column form B3:B12 are 10 cells without color, then color found and count stop, result on B1
And the same for the rest of the columns until G.

Any help will be very appreciated, thank you.

 

[DanteAmor]

How did the color get there, did you manually highlight the cell or with conditional formatting?

If you want it with formula then you would need to describe if there is a pattern to find the color.
If there is no pattern, then it would have to be with a macro.

 

[montecarlo2012]

Hi, and Thank you DanteAmor.
How the color get there, is generate by a code.
if I want with a formula?, Sorry NO.
there are not Pattern, because the code I gonna show you now, just highlight some matches found,
but beside, I need to count the cells until the yellow color is found
here I change location, sorry I didn't expect your question, thank you for your input, really good
ok so here is the code that highlight the cells.

Sub Monte_carlo_2012()
         Dim rngStart As Range, rngData As Range
         Dim Diff1 As Long, Diff2 As Long, NoRows As Long, NoCols As Long, i As Long
         Dim s As String
                  Set rngData = Range("B3:G2720") 'Cells(Rows.Count, "A").End(xlUp).Row
                           NoRows = rngData.Rows.Count
                           NoCols = rngData.Columns.Count
                           Diff1 = 8: Diff2 = 35
                  Set rngStart = Range("I3").Resize(, NoCols)
                           For i = Diff1 To Diff2
                                    With rngStart.Offset(, (NoCols + 1) * (i - Diff1)).Resize(NoRows - i)
                                                         .Rows(0).Formula = "=SUMPRODUCT(--(" & rngData.Resize(NoRows - i, 1).Address(0, 0) & "=" & .Columns(1).Address(0, 0) & "))"
                                                         .Rows(0).Font.Bold = True
                                                         .Formula = "=TRUNC(TREND(" & rngData.Resize(i + 1, 1).Address(0, 0) & "))"
                                                         s = .Cells(1, 1).Address(0, 0)
                                             With .FormatConditions
                                                      .Delete
                                                      .Add Type:=xlExpression, Formula1:="=" & rngData(1, 1).Address(0, 0) & "=" & s
                                                      .Item(1).Interior.Color = vbYellow
                                             End With
                                    End With
                           Next i
End Sub

Again, thank you.

 

[JoeMo]

Assuming the yellow fill is not the result of conditional formatting, try this:

Sub montecarlo()
'assumes cell interior yellow fill is applied manually, not by conditional formatting
Dim R As Range, Col As Long, Fnd As Range
Set R = Range("B3").CurrentRegion
Application.ScreenUpdating = False
For Col = 1 To R.Columns.Count
    With R.Columns(Col)
        Application.FindFormat.Clear
        Application.FindFormat.Interior.Color = vbYellow
        Set Fnd = .Cells.Find("", searchformat:=True)
        If Not Fnd Is Nothing Then
            If Fnd.Row = 3 Then
                .Cells(1, 1).Offset(-2, 0) = 0
            Else
                .Cells(1, 1).Offset(-2, 0) = Rows("3:" & Fnd.Row - 1).Count
            End If
        End If
    End With
Next Col
Application.ScreenUpdating = True
End Sub

 

[montecarlo2012]

JoeMo, Thank you Sir, As you mention in the notes ' assumes cell interior yellow fill is applied manually"; the code work IF there are not formatting yes, Sir, as I mention before the cell interior yellow fill
is generate by the code I upload. I am really thanks full Sir. Thank you. IF it is possible to be added some line to the other code and make one would be optimum.

 

[JoeMo]

JoeMo, Thank you Sir, As you mention in the notes ' assumes cell interior yellow fill is applied manually"; the code work IF there are not formatting yes, Sir, as I mention before the cell interior yellow fill
is generate by the code I upload. I am really thanks full Sir. Thank you. IF it is possible to be added some line to the other code and make one would be optimum.

You are welcome. To make "one" simply put the line below just before the End Sub line in the code you posted in Post #3 and put the code I posted below your code from Post #3:

Call montecarlo

 

[montecarlo2012]

Hello, Sir. JoeMo. Sorry for the delay, (" just come back from work"). Thank you for your kindness.

I did the steps:
End Sub
call montecarlo
your code

I am able to see the numbers pop up and vanished immediately, this line:
.Rows(0).Formula = "=SUMPRODUCT(--(" & rngData.Resize(NoRows - i, 1).Address(0, 0) & "=" & .Columns(1).Address(0, 0) & "))"
over-write your code results, so at the end I got back to the first place.
maybe moving the Sum product formula results from row 2, to row 1 , maybe that way your code can show me the result on row 2.?
I am not to familiar handling the structure ->With - End With<- [I see the sumproduct results on row 2 but the address is 0,0 -that is tricky for me]
sorry. Sir.
Again Thank you.

 

[JoeMo]

Hello, Sir. JoeMo. Sorry for the delay, (" just come back from work"). Thank you for your kindness.

I did the steps:
End Sub
call montecarlo
your code

I am able to see the numbers pop up and vanished immediately, this line:
.Rows(0).Formula = "=SUMPRODUCT(--(" & rngData.Resize(NoRows - i, 1).Address(0, 0) & "=" & .Columns(1).Address(0, 0) & "))"
over-write your code results, so at the end I got back to the first place.
maybe moving the Sum product formula results from row 2, to row 1 , maybe that way your code can show me the result on row 2.?
I am not to familiar handling the structure ->With - End With<- [I see the sumproduct results on row 2 but the address is 0,0 -that is tricky for me]
sorry. Sir.
Again Thank you.

The Call has to be BEFORE the End Sub, like this:
Sub Monte_carlo_2012()
.............
Call montecarlo
End Sub
Sub montecarlo
.....
End Sub

 

[montecarlo2012]

Hello. Thanks for coming back, and Yes Sir. I did exactly that.

 

[JoeMo]

I haven't looked at your code, but the yellow cell fill must be applied directly to the cell, not by conditional formatting, for the code I posted to work.