CODEWITHSUNDEEP
vba
Pythonn00b
Pythonn00b

Reputation: 325

VBA Processing duplicates in consecutive cells

I am trying to accomplish a small data cleaning task and want to use Excel VBA instead of my usual Python.

I have lists of items spread over columns on each row. Unfortunately there are duplicate items in these lists which I need to remove. It can be assumed each list will only have ~15 items max.

My attempt at psuedo code

Foreach row in selection:
Check Column n and n+1. (so thats column A and B for the first iteration)
If different, n++
If the same, remove the cell N+1 and shift all values to the right right of N+1 left 1 cell.
Check (n, n+1) again after.

I have attached a few example rows. Any help would be greatly appreciated - tragically I'm finding VBA harder than any other language I've tackled so far.

All three rows below should reduce to the same thing.

1 Apple Banana Chocolate Dog
2 Apple Banana Chocolate Chocolate Chocolate Dog
3 Apple Banana Chocolate Chocolate Chocolate Chocolate Chocolate Dog Dog Dog Dog

These three examples should all reduce down to

Apple Banana Chocolate Dog

Upvotes: 0

Views: 190

Answers (1)

AKDADEVIL
AKDADEVIL

Reputation: 206

Sure it can,

place a Commandbutton somewhere on your excel sheet and put this code in the VBA-Editor:

Private Sub CommandButton1_Click()
    RecurseRows 'Start recursion
End Sub

Private Sub RecurseRows(Optional row As Long = 1)
    RecurseColumns row, 1, 2

    If (row = ActiveSheet.Range("A65536").End(xlUp).row) Then
        Exit Sub 'End recursion when next row is empty
    Else
        RecurseRows row + 1 'next row
    End If
End Sub

Private Sub RecurseColumns(row As Long, col1 As Long, col2 As Long)
    If (IsEmpty(ActiveSheet.Cells(row, col2))) Then
        Exit Sub 'End recursion
    Else
        If (ActiveSheet.Cells(row, col1) = ActiveSheet.Cells(row, col2)) Then
            ActiveSheet.Cells(row, col2).Delete xlShiftToLeft 'Remove duplicate
            RecurseColumns row, col1, col2 'Check same couple again, since col2 has changed
        Else
            RecurseColumns row, col2, col2 + 1 'Shift one cell to the right
        End If
    End If
End Sub

Of course you can do it iteratively, too... XD

Upvotes: 2

Related Questions