Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

trouble clear dublicated items

0

hello

I  have this  code  doesn't  work  for  me.  it  should  delete  duplicates  items  based on column header CD  for three  sheets . I  no  know  what's  the  problem  . it  doesn't  show  any  error. 

Sub ClearCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, x As Long, col As Range
    For Each ws In Sheets(Array("mns", "LTTY", "LLO"))
        With ws
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set col = .Rows(1).Find("CD", LookIn:=xlValues, lookat:=xlWhole)
            For x = LastRow To 2 Step -1
                If .Cells(x, col.Column) <> "" Then
                    If .Cells(x, col.Column) = .Cells(x - 1, col.Column) Then
                        .Cells(x, col.Column).ClearContents
                    End If
                End If
            Next x
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

any  body  guide  me how  should  fix  it  ,please?

Answer
Discuss

Answers

0
Selected Answer

Alaa

You macro removes duplicates if they are in adjacent rows- if they are NOT sorted alphabetically first, then all duplicates will NOT be removed.

For example, in sheet LTTY, cells C2:C11 have values as follows:

CVF-12
CVF-13
CVF-14
CVF-13
CVF-14
CVF-15
CVF-15
CVF-16
CVF-18
CVF-19

The second item in bold (cell C8) will be cleared since it has CVF-15 (like C9) but other cells will not be cleared. Fior example it will see CVF-14 twice but with different values in the row above) so it won't clear those cells.

I suggest you first sort the data (after your line starting Set col= ) then it will remove all duplicates.

REVISION 1:

Given you have groups of products on worksheet mny (with totals), I've created a macro which checks if a row says "TOTAL" in the CD column and if so workout the range of rows to be sorted (e.g. between that and the next TOTAL row above) and repeat CD entries removed.. If there are no such rows, the same is done for row 2 to the last used row. I've added comments for guidance:

    Dim LastRow As Long, ws As Worksheet, n As Long, col As Range
    Dim StartRow As Long, BottomRow As Long

Sub ClearCells()

    Application.ScreenUpdating = False 

    For Each ws In Sheets(Array("mns", "LTTY", "LLO"))
        With ws

            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            BottomRow = LastRow
            Set col = .Rows(1).Find("CD", LookIn:=xlValues, lookat:=xlWhole)

            For n = LastRow To 2 Step -1
                Select Case .Cells(n, col.Column)
                    Case Is = ""
                        ' show user/ halt if a blank cell is found
                        .Activate
                        .Cells(n, col.Column).Select

                        MsgBox "Macro stopped when first blank cell encountered- cannot sort data with blank cells in CD column. (Has data been sorted already?)"
                        Application.ScreenUpdating = True
                        Exit Sub
                    Case Is = "TOTAL"
                        If n < BottomRow Then
                            ' if this line isn't the last used row, pick line below...
                            StartRow = n + 1
                            '.. then sort and clear
                            SortClear
                        End If
                        BottomRow = n - 1
                    Case Is <> "TOTAL"
                        ' Check if the top has been reached (and sort/clear if so)
                        If n = 2 Then
                            StartRow = n
                            SortClear
                        End If
                End Select

            Next n
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

Private Sub SortClear()

    Dim x As Long

    With ws
        ' sort the range
        .Sort.SortFields.Clear
        .Range(.Cells(StartRow, col.Column), .Cells(BottomRow, col.Column)).EntireRow.Sort Key1:=.Cells(StartRow, col.Column), Header:=xlNo
        ' loop back to clear repeated CD entries
        For x = BottomRow To StartRow + 1 Step -1
            If .Cells(x, col.Column) = .Cells(x - 1, col.Column) Then .Cells(x, col.Column).ClearContents
        Next x
    End With

End Sub

Note that I've used the Select Case / End Case approach and called a new, separate sub called SortClear (to avoid repeating your code for the two scenarios described above). You'll see that the Dim declarations are now made outside both macros (so that the variables will be known to both) and that the macro stops if it finds a blank cell in a CD column (which would indicate that it has run before perhaps)..

Hope this makes sense and solves your problem..

Discuss

Discussion

Hi John
thanks    , it  works  perfectly  , but  it  shows  problem  about  TOATL row in  first  sheet . after run  the  macro    moves  the  TOTAL  row  to  the  bottom and  delete  word   TOTAL .  the structure of  data should  keep without  any  change after  run  the macro .
I  added   bold line 
 Set col = .Rows(1).Find("CD", LookIn:=xlValues, lookat:=xlWhole)
             col.Sort Key1:=col, _
                   Order1:=xlAscending, _
                   Orientation:=xlSortColumns
Alaa (rep: 12) Mar 23, '22 at 9:15 am
Alaa. That means that sheet 1 needs to be handled differently (if the sub-totals are to be retained). I won't be near my PC for several hours now but will try to reply later or tomorrow. 

Have you now corrected those lines to read "Total"? 
John_Ru (rep: 3222) Mar 23, '22 at 10:20 am
not  yet .
Alaa (rep: 12) Mar 23, '22 at 4:23 pm
I  try  this  line 
If .Cells(x, col.Column) <> "" and .Cells(x, col.Column) <> "TOTAL" Then

it  doesn't  work
Alaa (rep: 12) Mar 27, '22 at 2:40 pm
Alla.

That line identifies "data" rows but more is needed...

Please see REVISION 1 to my Answer and the file attached to it.
John_Ru (rep: 3222) Mar 29, '22 at 6:05 am
I appreciate your assistance . all of things have fixed .
thanks John .
Alaa (rep: 12) Mar 29, '22 at 11:55 am
That's good Alaa. Thanks for selecting my Answer. 
John_Ru (rep: 3222) Mar 29, '22 at 12:38 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login