Case Sensitive Duplicate Removal in Array

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi,

I have a data range in columns A:G. I want to remove data in each row in columns A:G based on duplicate values in column G.

The following code works well to remove duplicates in column G alone however I want to remove the data in all columns of the row with the duplicate value.

Any help appreciated.

Ryan


Dim a, e, x


For i = 1 To 5
Cells(1, i * 7).Select
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column))
a = .Value
.ClearContents
With CreateObject("Scripting.Dictionary")
For Each e In a
.Item(e) = Empty
Next
x = .keys
End With
.Resize(UBound(x) + 1).Value = Application.Transpose(x)
End With
 

RickXL

MrExcel MVP
Joined
Sep 9, 2013
Messages
4,314
Hi,

It looks from the initial For loop that you want to repeat this for other groups of seven columns. If that is so, do you want the entire row to be deleted or just the seven columns in that iteration of the loop?

Aso, I think your second loop will run for all rows not just the populated ones in the column.
 

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi,

I just want to delete the data in thos 7 columns because as you stated it will run for other groups of columns.

That is fine if it runs for all rows as they will be empty anyway.

Thanks for your assistance.
 

RickXL

MrExcel MVP
Joined
Sep 9, 2013
Messages
4,314
Hi,

Try this:
Code:
Sub delRows()

    Dim ws As Worksheet
    Dim arrIn As Variant
    Dim arrOut As Variant
    Dim i As Long, j As Long, k As Long
    Dim dic As Object
    
    Set ws = ThisWorkbook.ActiveSheet
    Set dic = CreateObject("Scripting.Dictionary")
    
    With ws
    
        For i = 7 To 35 Step 7
            arrIn = .Range(.Cells(1, i - 6), .Cells(.Cells(.Rows.Count, i).End(xlUp).Row, i)).Value
            dic.RemoveAll
            For j = 1 To UBound(arrIn)
                dic(arrIn(j, 7)) = j
            Next
        
            ReDim arrOut(1 To dic.Count, 1 To 7)
            For j = 1 To dic.Count
                For k = 1 To 7
                    arrOut(j, k) = arrIn(dic.Items()(j - 1), k)
                Next
            Next
            
            .Columns(i).Offset(, -6).Resize(, 7).Clear
            .Cells(1, i - 6).Resize(dic.Count, 7) = arrOut
        Next
        
    End With

End Sub
I would be uneasy about trying out something that could trash all the data in a worksheet without a backup. in fact, I would normally write something like this to read from one sheet and write to another.

It continues your idea of using a dictionary to get a unique list of keys but it saves the row number as it is doing it.
It also reads in the whole block of seven columns into the same array.
When the data is transferred from the input array to the output array it uses only those rows that were saved in the dictionary.
 

Forum statistics

Threads
1,081,525
Messages
5,359,272
Members
400,523
Latest member
ExcelNewbie98

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top