Macro comparing cells in sense inverse and counting until criteria is met

[Luis Ramirez]

Hello Guys,

I am looking for a macro a bit difficult, at least to my expertise level. I have a column with values:

A1. 100
A2. 98
A3. 19
A4. 134
A5. 234
A6. 21

Then I need to compare each cell with previous one (let´s say A6 with A5) IF the value is minor then continue to compare with next previous next one (A6 with A4 in this case). And continue to do it until the value is greater (in this case until A3). A counter must show up the number of cells that met the criteria (in this case 2, A5 and A4).

If someone can put me on the right track will be really great!

 

[Somendra Misra]

Hi Luis,

Try below code,

Sub counterTest()

Dim lr As Long
Dim cntr As Long

cntr = 0


lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = lr - 1 To 1 Step -1
    If Cells(lr, 1) <= Cells(i, 1) Then
        cntr = cntr + 1
    Else
    Exit For
    End If
Next i

MsgBox cntr

   

End Sub

Regards,

 

[Sathish KV]

Hi Luis,

In the above macro you can change the code

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

To
 
lr = ActiveCell.Row

This will work based on the cell which you have selected

 

[Luis Ramirez]

Thanks Somendra and Sathish,

You are very good. Actually what I need is that automatically goes through range A1:A6 (or whatever range) and verify cell by cell, and if it is greater than the previous one, continue with the next one, counting until this criteria is no longer met. So at the end I should have a list like this:


A1. 100 0
A2. 98 1
A3. 19 2
A4. 134 0
A5. 234 0
A6. 21 2

Taking the code of Somendra, I tried this:

Sub counterTest()

Dim lr As Long
Dim cntr As Long
Dim n As Long

cntr = 0

lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For n = 2 To lr Step 1

If Cells(n, 1) <= Cells(n - 1, 1) Then

For i = n - 1 To 1 Step -1
If Cells(n, 1) <= Cells(i, 1) Then
cntr = cntr + 1
Else
Exit For
End If
Next i
ActiveSheet.Cells(n, 2) = cntr

Else
ActiveSheet.Cells(n, 2) = 0
End If

Next n

End Sub

Nevertheless, I can not get the counter to work properly.

I tried other codes, using the FOR cycle first, but it did not work. You already have put in the right track guys, so if you have any additional inside, it will be great. And really thanks.

Luis

 

[NARAYANK991]

Hi Luis ,

Can you see whether this works ?

Public Sub Insert_Counter()
          Dim Number_of_rows As Long
          Number_of_rows = [List].Rows.Count
                     
          For Each cell In [List]
              If cell.Row = [List].Row Then
                  cell.Offset(0, 1).Value = 0
              Else
                  i = 1
                  counter = 0
                  Do While cell < cell.Offset(-i).Value
                    counter = counter + 1
                    i = i + 1
                    If cell.Offset(-i).Row < [List].Row Then Exit Do
                  Loop
                  cell.Offset(0, 1).Value = counter
              End If
          Next
End Sub

Narayan

 

[Somendra Misra]

@Luis Ramirez

Here another option:

Sub counterTest()

Dim lr As Long
Dim cntr As Long

cntr = 0


lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For j = lr To 1 Step -1
    For i = j - 1 To 1 Step -1
    If Cells(j, 1) <= Cells(i, 1) Then
        cntr = cntr + 1
    Else
    Exit For
    End If
    Next i
    Cells(j, 2) = cntr
    cntr = 0
Next j

   

End Sub

Regards,