Find count of consecutive values

user_13699739 0
Viewed 84

I am trying to find the count of consecutive values in order to change it to another value. Example :

A
A
B
A
B
B
B
B
A

If there are consecutive values (AA, AAA, AAAA.. or BB, BBB, BBBB...) then replace the second and corresponding values with C

I tried the following code: 

Dim values As Integer
values = Range().Rows.Count

For i = 1 To values
    If Range().Cells(i, 1) = Range().Cells(i + 1, 1) Then
        Range().Cells(i + 1, 1) = “C”
    End If
Next i

However this only takes into account 2 consecutive values and not more than 2.. how do I fix my code?

Appreciate the help.

Thanks

vba excel
3 Answers

Try the next code, please. In your code, after first replace, the condition does not matches, anymore. The code assumes that the column to be processed is "A:A":

Sub removeConsecRowsValue()
  Dim sh As Worksheet, values As Long, i As Long, j As Long
   Set sh = ActiveSheet 'use here your sheet
   values = Range("A" & Rows.count).End(xlUp).Row 'supposing that the column to be processed is A:A
    For i = 1 To values
        If sh.Range("A" & i).value = sh.Range("A" & i + 1).value Then
            Dim rng As Range
            For j = i + 1 To i + 1000
                If sh.Range("A" & j).value = sh.Range("A" & i).value Then
                    If rng Is Nothing Then
                       Set rng = sh.Range("A" & j)
                    Else
                       Set rng = Union(rng, sh.Range("A" & j))
                    End If
                Else
                    rng.Replace sh.Range("A" & i).value, "C"
                    Exit For
                End If
            Next j
        End If
    Next i
End Sub
user_22333080

Replace Consecutive

  • Copy the complete code into a standard module (e.g. Module1).
  • Run only the Sub.
  • The Function is called by the Sub.
  • Adjust the constants in the Sub.

The Code

Option Explicit

Sub ConsecutiveExample()

    Const rngAddress As String = "A1:A20"
    Const Criteria As Variant = "C"

    Dim rng As Range:Set rng = Range(rngAddress)
    Dim Target As Variant:Target = replaceConsecutive(rng, Criteria)

    If Not IsEmpty(Target) Then rng.Value = Target

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Replaces each next consecutive value in a one-column range
'               with a specified criteria and returns a 2D one-based one-column
'               array containing the modified values.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function replaceConsecutive(SourceRange As Range, ByVal Criteria As Variant, _
  Optional ByVal AnyColumn As Long = 1) As Variant

    Dim Source As Variant: Source = SourceRange.Columns(AnyColumn).Value
    If Not IsArray(Source) Then Exit Function

    Dim Target As Variant: Target = Source
    Dim i As Long

    For i = 2 To UBound(Source)
        If Source(i, 1) = Source(i - 1, 1) Then Target(i, 1) = Criteria
    Next i
    Erase Source

    replaceConsecutive = Target

End Function
user_98140690

You need to just reverse the loop and test the conditions as @Gary's student has suggested. See below code.

Dim lngLastRow As Long, i As Long
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = lngLastRow To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1).Value Then Range("A" & i).Value = "C"
Next i
user_87599270
Related