CODEWITHSUNDEEP
excelvba
user12046892
user12046892

Reputation:

How to find duplicate in the same cell and erase one instance in VBA

A separate program that I cannot change adds to a spreadsheet and sometimes it duplicates something.

For example:in cell 5, 3

ABC, vbd, S19M-0027757-27760, S19M-0027757-27760(1)

or it could be

ABC, vbd S19M-0027757-27760, S19M-0027757-27760(1)

What I need to do is replace both of them with S19M-0027757-27760(1) so the out come would be:

ABC, vbd, S19M-0027757-27760(1)

So far I have:

For i = 5 To lRow
   inputArray = Split(Cells(i, 3).Value, " ")
   For j = 0 To (UBound(inputArray) - LBound(inputArray) - 1)
      Dim firstString As String
      Dim secondString As String
      firstString = inputArray(j)
      secondString = inputArray(j + 1)        
   Next
Next

I am thinking the next step would be to compare letter by letter? But what about the comma and (1)?

Upvotes: 0

Views: 68

Answers (2)

JvdV
JvdV

Reputation: 75840

Some other way, possible through RegEx:

Sub Test()

Dim RegEx As Object: Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = "([A-Z0-9-]{18})(?=.+\1)"

Dim lr As Long, x As Long
With Sheet1
    lr = .Cells(.Rows.Count, 3).End(xlUp).Row
    For x = 5 To lr
        .Cells(x, 3).Value = Replace(Replace(RegEx.Replace(.Cells(x, 3).Value, ""), ", ,", ", "), " ,", ", ")
    Next x
End With

End Sub

I agree with @SJR, some more examples would be great to know if the RegEx.Pattern would hold TRUE. I now went with the assumptions of 18-char patterns. It would hold for the current sample data:

Before:

enter image description here

After:

enter image description here

Upvotes: 0

SJR
SJR

Reputation: 23081

Try this. Possibly not enough examples to be sure it will work in all cases, but a short test worked.

Sub x()

Dim i As Long, inputArray, j As Long, outputArray(), k As Long

For i = 1 To 3
    inputArray = Split(Cells(i, 3).Value, ", ")
    For j = LBound(inputArray) To UBound(inputArray)
            k = k + 1
            ReDim Preserve outputArray(1 To k)
        If j = UBound(inputArray) - 1 Then
            If inputArray(j + 1) Like inputArray(j) & "(*)" Then
                outputArray(k) = inputArray(j + 1)
                Exit For
            Else
                outputArray(k) = inputArray(j)
            End If
        Else
            outputArray(k) = inputArray(j)
        End If
    Next j
    Cells(i, 4).Value = Join(outputArray, ", ")
    Erase outputArray: k = 0
Next i

End Sub

enter image description here

Upvotes: 1

Related Questions