Results 1 to 3 of 3
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    delete dupes in orizzontal (2000 sr 1)

    the sheet contain (range BK:BO) many value...
    Is possoble to delete the dupes in this range and fit to the left the remain value...?
    In yellow the dupes...
    in this case in line 4 remain only 3 value, and in line 16 remain 1 value.
    Tks.

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: delete dupes in orizzontal (2000 sr 1)

    How about this:
    <pre>Option Explicit
    Sub DeleteDupesHor()
    Dim rng As Range
    Dim rRow As Range
    Dim rCell As Range
    Dim lRow As Long
    Dim lRows As Long
    Dim iCol As Integer
    Dim iCols As Integer
    Dim AWF As WorksheetFunction

    Set rng = Range("BK3:BO591")
    Set AWF = Application.WorksheetFunction
    With rng
    iCols = .Columns.Count
    lRows = .Rows.Count
    For lRow = 1 To lRows
    Set rRow = .Rows(lRow)
    For iCol = iCols To 1 Step -1
    Set rCell = .Cells(lRow, iCol)
    If rCell.Value <> "" _
    And AWF.CountIf(rRow, rCell) > 1 Then
    If iCol < iCols Then
    Range(rCell.Offset(0, 1), _
    .Cells(lRow, iCols)).Copy rCell
    End If
    .Cells(lRow, iCols).ClearContents
    End If
    Next iCol
    Next lRow
    End With
    Set rCell = Nothing
    Set rRow = Nothing
    Set rng = Nothing
    Set AWF = Nothing
    MsgBox "Done"
    End Sub</pre>


    Steve

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: delete dupes in orizzontal (2000 sr 1)

    "kiss" and Tks.
    ... Work fine.
    Sal.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •