Macro to delete the Duplicate columns

H

harshab6

Active Member
Joined
Oct 1, 2008
Messages
254
Hi Experts,

I have a data below.


[TABLE="width: 192"]
<TBODY>[TR]
[TD]A</SPAN>
[/TD]
[TD]B </SPAN>
[/TD]
[TD]C</SPAN>
[/TD]
[/TR]
[TR]
[TD]161600</SPAN>
[/TD]
[TD]IO</SPAN>
[/TD]
[TD="align: right"]20000</SPAN>
[/TD]
[/TR]
[TR]
[TD]161601</SPAN>
[/TD]
[TD]AF</SPAN>
[/TD]
[TD="align: right"]20000</SPAN>
[/TD]
[/TR]
[TR]
[TD]163348</SPAN>
[/TD]
[TD]AB</SPAN>
[/TD]
[TD="align: right"]60000</SPAN>
[/TD]
[/TR]
[TR]
[TD]161600</SPAN>
[/TD]
[TD]IO</SPAN>
[/TD]
[TD="align: right"]20000</SPAN>
[/TD]
[/TR]
[TR]
[TD]166240</SPAN>
[/TD]
[TD]AC</SPAN>
[/TD]
[TD="align: right"]24000</SPAN>
[/TD]
[/TR]
[TR]
[TD]168114</SPAN>
[/TD]
[TD]AF</SPAN>
[/TD]
[TD="align: right"]22000</SPAN>
[/TD]
[/TR]
[TR]
[TD]161175</SPAN>
[/TD]
[TD]AC</SPAN>
[/TD]
[TD="align: right"]12000</SPAN>
[/TD]
[/TR]
</TBODY>[/TABLE]
</SPAN>


if the numbers in column A matches and its updated as IO in column B , and amount in column C matches then the macro should automatically delete those columns.</SPAN>

Thanks and Regards,
Harsha
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
Hi harshab6,

Do you mean row and not columns in the following statement?

If the numbers in column A matches and it is updated as IO in column B, and the amount in column C matches then the macro should automatically delete those columns.

I think you mean to delete the 4th row (Ie the 2nd occurrence)
 
Upvote 0
Hi harshab6,

Sorry for the delay in replying but have been very busy.

Please see code below, together with commented instructions below.

I've assumed the following,

1) Delete only duplicated 'IO' values, (All other types ignore)


Hope the code works for you and enjoy.

Code: 
Public Function DeleteDupIO()

    Dim ws                      As Worksheet
    Dim lngMaxRow               As Long
    Dim IOColl                  As Collection                           'using an index you can't have duplicates
    Dim strIO                   As String                               'concatenate columns A & B & C
    Dim arrDupFoundRow()        As Long                                 'Row no of any duplicate record
    Dim lngDupFound             As Long                                 'number of duplicates found
    
    Set IOColl = New Collection
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")                          'change Sheet1 to the name of your Sheet
    
'in excel earlier then 2007 change "A1048576" to "A65536"
    lngMaxRow = ws.Range("A1048576").End(xlUp).Row                      'find last row of data
    
    lngDupFound = 0
    For i = 2 To lngMaxRow                                              'loop through each row
        If ws.Range("B" & i) = "IO" Then                                'only want IO in column B
            strIO = ws.Range("A" & i) & "_" & ws.Range("B" & i) & "_" & ws.Range("C" & i)       'concatenate columns A & B & C
            On Error GoTo dupFound                                      'add to not found list arrDupFoundRow()
            IOColl.Add strIO, strIO                                     'add to Collection
         End If
    Next i
    
    If lngDupFound > 0 Then                                             'we have found more than 1 duplicate entry
        For i = UBound(arrDupFoundRow) To 1 Step -1                     'when deleting rows you must to in reverse otherwise you delete the wrong row
            ws.Range("A" & arrDupFoundRow(i)).EntireRow.Delete          'deleted whole row
        Next i
    End If

    'clear varables to nothing
    Set ws = Nothing
    Set IOColl = Nothing
    Erase arrDupFoundRow    

    Exit Function
    
dupFound:
    lngDupFound = lngDupFound + 1                                       'add 1 to no of dups fround
    ReDim Preserve arrDupFoundRow(lngDupFound)                          're dimention and preserve list data to add a new one
    arrDupFoundRow(lngDupFound) = i                                     'add row no to be deleted to the arrDupFoundRow() list
    
    Resume Next                                                         'go back to line after error
End Function
 
Last edited:
Upvote 0
Thanks for the Code,it works like a Charm,Just I need it in another criteria In case If in column A numbers matches and its IO in column B and there is positive and negative amount which sums to zero then Macro should automatically delete those lines.

[TABLE="width: 192"]
<tbody>[TR]
[TD="width: 64"]A[/TD]
[TD="width: 64"]B[/TD]
[TD="width: 64"]C[/TD]
[/TR]
[TR]
[TD="align: right"]160100 [/TD]
[TD]IO [/TD]
[TD="align: right"]20000[/TD]
[/TR]
[TR]
[TD="align: right"]160101[/TD]
[TD]AH[/TD]
[TD="align: right"]30000[/TD]
[/TR]
[TR]
[TD="align: right"]160102[/TD]
[TD]IO[/TD]
[TD="align: right"]40000[/TD]
[/TR]
[TR]
[TD="align: right"]160103[/TD]
[TD] AB[/TD]
[TD="align: right"]50000[/TD]
[/TR]
[TR]
[TD="align: right"]160104[/TD]
[TD]AC[/TD]
[TD="align: right"]60000[/TD]
[/TR]
[TR]
[TD="align: right"]160105[/TD]
[TD] AD[/TD]
[TD="align: right"]70000[/TD]
[/TR]
[TR]
[TD="align: right"]160106[/TD]
[TD] TM[/TD]
[TD="align: right"]80000[/TD]
[/TR]
[TR]
[TD="align: right"]160100[/TD]
[TD] IO [/TD]
[TD="align: right"]-20000[/TD]
[/TR]
</tbody>[/TABLE]

In above example in A column number 160100 and in B column its IO there is positive of 20000 and negative of 20000 below which sums to zero so both the rows with positive and negative identical numbers need to get deleted.
 
Last edited:
Upvote 0
Hi once again,

Not the neatest code but it's functional and should do the job.

It's never easy deleting items from a list since the row numbers move up.

Hope code works for you and enjoy.

Ps don't forget to rate my responses.

Code: 
Public Function DeleteDupIO()

    Dim ws                      As Worksheet
    Dim lngMaxRow               As Long
    Dim IOColl                  As Collection                           'using an index you can't have duplicates
    Dim IOCol                   As Variant
    Dim strIO                   As String                               'concatenate columns A & B & C
    Dim arrDupFoundRow()        As Long                                 'Row no of any duplicate record
    Dim lngDupFound             As Long                                 'number of duplicates found
    Dim arrIOcol()              As String
    Dim strSearch               As String
    Dim blnLoop                 As Boolean
    Set IOColl = New Collection
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")                          'change Sheet1 to the name of your Sheet
    
'in excel earlier then 2007 change "A1048576" to "A65536"
    lngMaxRow = ws.Range("A1048576").End(xlUp).Row                      'find last row of data
    
    lngDupFound = 0
    For i = 2 To lngMaxRow                                              'loop through each row
        If ws.Range("B" & i) = "IO" Then                                'only want IO in column B
            strIO = ws.Range("A" & i) & "_" & ws.Range("B" & i) & "_" & ws.Range("C" & i)       'concatenate columns A & B & C
            On Error GoTo dupFound                                      'add to not found list arrDupFoundRow()
            IOColl.Add strIO, strIO                                     'add to Collection
         End If
    Next i
    
    If lngDupFound > 0 Then                                             'we have found more than 1 duplicate entry
        For i = UBound(arrDupFoundRow) To 1 Step -1                     'when deleting rows you must to in reverse otherwise you delete the wrong row
            ws.Range("A" & arrDupFoundRow(i)).EntireRow.Delete          'deleted whole row
        Next i
    End If
    
    'now Check both both postive and negative IO items that equate to zero to be deleted
    blnLoop = True
LoopStartsHere:
    Do Until blnLoop = False
    
        blnLoop = False
        'now delete both both postive and negative IO items that equate to zero
        For Each IOCol In IOColl
            arrIOcol = Split(IOCol, "_")
            
            If CLng(arrIOcol(2)) < 0 Then                            'we have found a negative
                'do we have a postive value of the same value using the index if so ve have to delete
                On Error GoTo no_Item
                    IOColl.Item arrIOcol(0) & "_" & arrIOcol(1) & "_" & Abs(arrIOcol(2))


                    'delete positive in worksheet
                    
                    lngMaxRow = ws.Range("A1048576").End(xlUp).Row                      'find last row of data
                    For i = 2 To lngMaxRow                                              'loop through each row in worksheet
                        If ws.Range("B" & i) = arrIOcol(1) Then
                            If ws.Range("A" & i) = arrIOcol(0) Then
                                If ws.Range("C" & i) = Abs(arrIOcol(2)) Then
                                    ws.Range("C" & i).EntireRow.Delete
                                    IOColl.Remove arrIOcol(0) & "_" & arrIOcol(1) & "_" & Abs(arrIOcol(2))          'delete positive
                                    Exit For
                                End If
                            End If
                        End If
                    Next i
                    'delete negative in worksheet
                    lngMaxRow = ws.Range("A1048576").End(xlUp).Row                      'find last row of data
                    For i = 2 To lngMaxRow                                              'loop through each row in worksheet
                        If ws.Range("B" & i) = arrIOcol(1) Then
                            If ws.Range("A" & i) = arrIOcol(0) Then
                                If ws.Range("C" & i) = arrIOcol(2) Then
                                    ws.Range("C" & i).EntireRow.Delete
                                    blnLoop = True                                      'need to go round & round until no more
                                    IOColl.Remove arrIOcol(0) & "_" & arrIOcol(1) & "_" & arrIOcol(2)               'delete negative
                                    Exit For
                                End If
                            End If
                        End If
                    Next i
            End If
    
no_Item:
       
        If blnLoop = True Then Exit For
        Next IOCol
    
        If blnLoop = True Then GoTo LoopStartsHere                      'go and see if any more
    Loop


    'clear varables to nothing
    
    Set ws = Nothing
    Set IOColl = Nothing
    Erase arrDupFoundRow
    Erase arrIOcol
    Exit Function
    
dupFound:
    lngDupFound = lngDupFound + 1                                       'add 1 to no of dups fround
    ReDim Preserve arrDupFoundRow(lngDupFound)                          're dimention and preserve list data to add a new one
    arrDupFoundRow(lngDupFound) = i                                     'add row no to be deleted to the arrDupFoundRow() list
    
    Resume Next                                                         'go back to line after error
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
Call a macro based on text in column C (same row that is active).
Replies
8
Views
119
6StringJazzer
6StringJazzer
A
  • Question Question
Duplicate Conditional Formatting with non-exact search inquiry
Replies
3
Views
174
arun_eagertolearn
A
O
  • Solved
If I delete row from sheet then decrease amount in other sheet
Replies
4
Views
268
mumps
mumps
A
  • Question Question
Delete most of all of ranges except specific ranges based on cell value
Replies
0
Views
201
Abdo
A
T
  • Question Question
Find duplicates from column B and delete them in column A
Replies
1
Views
332
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top