Find repeating characters in cell that are in sequence

[markman2]

Been trying to figure this out lately-

I have excel data in a unique system where a cell has multiple values for SKUs
For example
1231223525
123512AA12
bR1124ABAGGA

i was hoping if there is a formula or a Sub where we can run it on the cell like MID(A1, (LEFT(A1)=",") + 1, LEN(A1)) to trim commas,
where output can be -
1231223525 | 22
123512AA12 | AA
bR1124AAABAGGA | 11| AAA | GG

Any suggestions or direction would be much appreciated! Thanks.

 

[lrobbo314]

This UDF seems to replicate the results you are looking for.

Function Sequential(s As String) As String
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim tmp As String: tmp = Left(s, 1)

For i = 2 To Len(s)
    If Mid(s, i, 1) = Mid(s, i - 1, 1) Then
        tmp = tmp & tmp
    Else
        If Len(tmp) > 1 Then AL.Add tmp
        tmp = Mid(s, i, 1)
    End If
Next i

Sequential = Join(AL.toarray, "|")

End Function

 

[Perpa]

Irobbo314,
Your Sequential function seems to work properly, except on the last (4th) line below where there is an extra 'A'. See red font.
I tried but was unable to sort that out with your code.
Perpa


1231223525 22
123512AA12 AA
bR1124ABAGGA 11 | GG

bR1124AAABAGGA 11 | AAAA | GG

 

[Fluff]

Try this mod

    If Mid(s, i, 1) = Mid(s, i - 1, 1) Then
        tmp = tmp & [COLOR=#ff0000]Mid(s, i, 1)[/COLOR]
    Else
        If Len(tmp) > 1 Then AL.Add tmp
        tmp = Mid(s, i, 1)
    End If

 

[DanteAmor]

Try this

Function RepeatingChar(letters As Range)
    Dim i As Long, ant As String, c As String, cad As String
    For i = 1 To Len(letters) + 1
        If ant <> Mid(letters, i, 1) Then
            If Len(c) > 1 Then cad = cad & c & "| "
            c = ""
        End If
        c = c & Mid(letters, i, 1)
        ant = Mid(letters, i, 1)
    Next
    If cad <> "" Then RepeatingChar = Left(cad, Len(cad) - 2)
End Function

it works with the cell parameter:
=RepeatingChar(A1)

 

[DanteAmor]

Try this mod

    If Mid(s, i, 1) = Mid(s, i - 1, 1) Then
        tmp = tmp & [COLOR=#ff0000]Mid(s, i, 1)[/COLOR]
    Else
        If Len(tmp) > 1 Then AL.Add tmp
        tmp = Mid(s, i, 1)
    End If

Miss this detail, if in the last letter there is a sequence:

Function Sequential(s As String) As String
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim tmp As String: tmp = Left(s, 1)


For i = 2 To Len(s) [COLOR=#ff0000]+ 1[/COLOR]
    If Mid(s, i, 1) = Mid(s, i - 1, 1) Then
        tmp = tmp &[COLOR=#0000ff] Mid(s, i, 1)[/COLOR]
    Else
        If Len(tmp) > 1 Then AL.Add tmp
        tmp = Mid(s, i, 1)
    End If
Next i


Sequential = Join(AL.toarray, "|")


End Function

 

[Perpa]

Fluff and Dante Amor,
I worked it out myself as well, and then saw your responses when I returned to the forum later.
Thank you both...and Regards as well.
Perpa

 

[DanteAmor]

Fluff and Dante Amor,
I worked it out myself as well, and then saw your responses when I returned to the forum later.
Thank you both...and Regards as well.
Perpa

You're welcome.

 

[lrobbo314]

Another way using regular expressions.

Function Repetition(s As String) As String
Dim RX As Object: Set RX = CreateObject("VBScript.RegExp")
Dim Pat As String: Pat = "(\w)\1+"
Dim result As String

With RX
    .ignorecase = True
    .MultiLine = True
    .Global = True
    .Pattern = Pat
    Set matches = .Execute(s)
End With

For i = 0 To matches.Count - 1
    result = result & matches(i)
    If i < matches.Count - 1 Then result = result & "|"
Next i

Repetition = result

End Function