CODEWITHSUNDEEP
excelvba
dah97765
dah97765

Reputation: 687

Removing duplicates within a row

Friends,

I have an excel table that repeats for a few thousand rows. 3 categories of columns, which may repeat, such as in the second row shown below

Is there a way to have excel cycle through a row and remove the duplicates within the row, so that it ultimately looks like the second table shown below?

enter image description here

Upvotes: 1

Views: 3294

Answers (2)

Kirk Bausch
Kirk Bausch

Reputation: 21

Here's how i solved for it. Not the prettiest but it works:

Removing duplicates phones from row

Sub PhoneDedupByRow()

    Dim Loopcounter As Long
    Dim NumberOfCells As Long
Application.ScreenUpdating = False
   'Range starting at A1
    Worksheets("Sheet1").Activate
    NumberOfCells = Range("A2", Range("A2").End(xlDown)).Count

    For Loopcounter = 1 To NumberOfCells
    'copies each section...I need to select the proper offsets for cells with the ph#'
    Range(Range("A1").Offset(Loopcounter, 10), Range("A1").Offset(Loopcounter, 19)).Copy
    'This is where the past/transpose will go...push it out to a far out column to avoid errors
    Range("W1").Select
       Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Application.CutCopyMode = False
    'Knowing the range is 10 cells, i added 11 because gotospecial with no blanks causes an error
    Range("W1:W11").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp


    ActiveSheet.Range("W1:W10").RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveSheet.Range("W1:W10").Select
    Selection.Copy

    Range(Range("A1").Offset(Loopcounter, 10), Range("A1").Offset(Loopcounter, 19)).Select
               Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Application.CutCopyMode = False
     ActiveSheet.Range("W1:W10").Select
      Selection.ClearContents


    Next Loopcounter

Application.ScreenUpdating = True
End Sub

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149335

I am not sure but is this what you are trying?

Option Explicit

Sub Sample()
    Dim wsI As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, j As Long
    Dim sVal1, sVal2, sVal3

    '~~> Input Sheet
    Set wsI = Sheets("Sheet1")

    With wsI
        lastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
                  Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, MatchCase:=False).Row

        lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _
                  Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
                  SearchDirection:=xlPrevious, MatchCase:=False).Column

        For i = 1 To lastRow
            sVal1 = .Cells(i, 1).Value
            sVal2 = .Cells(i, 2).Value
            sVal3 = .Cells(i, 3).Value

            For j = 4 To lastCol Step 3
               If .Cells(i, j).Value = sVal1 And _
               .Cells(i, j + 1).Value = sVal2 And _
               .Cells(i, j + 2).Value = sVal3 Then
                    .Cells(i, j).ClearContents
                    .Cells(i, j + 1).ClearContents
                    .Cells(i, j + 2).ClearContents
               End If
            Next j
        Next i
    End With
End Sub

Upvotes: 2

Related Questions