VBA Compare Rows, Count up if the same-CodePudding

Im super new to coding, i hope you guys can help me. In column A i have some strings and would like to count all the same ones up in Column L. And it should jump to the next row if there is nothig in Column G How it should look:

      A           G    L
zu=host,out=fr    x     1
zu=host,out=fr    x     2
zu=host,out=de    x     1
zu=host,out=de    x     2
zu=host,out=en    x     1
zu=host,out=sw    x     1
zu=host,out=sw    x     2
zu=host,out=nw 
zu=host,out=tw    x     1

This is my try, which sadly does not work:

Dim i As Integer
Dim ws As Worksheet
Dim counter As Integer
Set ws = ActiveSheet
counter = 1

For i = 1 To 5000

        If IsEmpty(ws.Range("A" & i)) Then
            Exit For
        End If
            
            If ws.Range("A" & i).Value = ws.Range("A" & i   1).Value Then
                    ws.Range("L" & i).Value = counter
                    counter = counter   1
                        Exit For
             
            Else: ws.Range("L" & i).Value = 1
                  counter = 1
                        Exit For
            End If
           
    Next i
    MsgBox ("Finished ")

CodePudding user response：

No need for VBA. A simple formula can achieve it. Put =COUNTIF($A$1:A1,A1) in cell L1 and drag it down. I am assuming that your data starts from cell A1.

If you still want VBA, then do this. I have commented the code. If you still have problems understanding it then do let me know.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim LRow As Long
    
    '~~> Set this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last row in col A
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Put the formula in the Col L in 1 go!
        .Range("L1:L" & LRow).Formula = "=COUNTIF($A$1:A1,A1)"
        '~~> Convert formula to values
        .Range("L1:L" & LRow).Value = .Range("L1:L" & LRow).Value
    End With
End Sub

Screenshot

CodePudding user response：

Having blank rows means it's not a simple as comparing the next or previous rows.

Sub CountUp()

    Dim ws As Worksheet
    Dim LastRow As Long, i As Long, counter As Long
    Dim sLastA As String
    Set ws = ActiveSheet

    LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    counter = 1
    For i = 1 To LastRow
        If ws.Cells(i, "G") > 0 Then
            If ws.Cells(i, "A") = sLastA Then
                counter = counter   1
            Else
                counter = 1
            End If
            ws.Cells(i, "L") = counter
            sLastA = ws.Cells(i, "A")
        End If
    Next i
    MsgBox ("Finished ")

End Sub

CodePudding user response：

Here are some suggestions to get the original code working:

Option Explicit

Sub Count()
    Dim i As Long
    Dim ws As Worksheet
    Dim counter As Integer
    Set ws = ActiveSheet
    counter = 1
    
    ' Start at row 2
    
    For i = 2 To 10
    Debug.Print ("i=" & i)
    
    ' This will exit completely if it finds a blank in column G

        If IsEmpty(ws.Range("G" & i)) Then
            Exit For
        End If
            
         'Compare the current row to the previous row
         
         If ws.Range("A" & i).Value = ws.Range("A" & i - 1).Value Then
         Debug.Print ("i1=" & i)
                
                 counter = counter   1
                     
         ' Don''t need to compare to previous value in column L - if current row doesn't match previous row, this just resets counter to 1.
         
         Else
         Debug.Print ("i2=" & i)
               counter = 1
                     
         End If
        
        ' Always write counter to column L
        
         ws.Range("L" & i).Value = counter
         
    Next i
    MsgBox ("Finished ")
    
End Sub