Delete Rows Code

[Dazzawm]

I have the code below that deletes duplicate rows depending on what column I select. At the moment when it deletes a row it takes whatever is in column X from the deleted rows and adds it into the remaning rows column X. I need the values from S and V incorparated too. Thanks,

Sub delrows()
Dim d As Object, u(), nr&, xcol As Range
Dim c As Range, col, i&, k&, x
Set d = CreateObject("scripting.dictionary")
nr = Cells.Find("*", after:=Cells(1), searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
ReDim u(1 To nr, 1 To 1)
Set c = Cells(1, Columns.Count)
col = Selection.EntireColumn
Set xcol = Cells.Range("X:X")
For i = 1 To nr
    x = col(i, 1)
    If Not d.exists(x) Then
        d.Add x, i
    Else
        u(i, 1) = 1
        k = k + 1
        Cells.Rows(d(x)).Interior.Color = vbCyan
        xcol(d(x)) = xcol(d(x)) & " " & xcol(i)
    End If
Next i
c.Resize(nr) = u
Cells.Resize(nr, Columns.Count).Sort c, 1
If k > 0 Then Cells.Resize(k, Columns.Count).Delete xlUp
End Sub

 

[Dazzawm]

^

 

[Zack Barresse]

Hi there,

Not sure I follow. Can you describe the ranges you're dealing with here? Also, why can you not use the built-in functionality of deleting duplicates from a range that is in 2007? Your statement, "I need the values from S and V incorparated too," doesn't give us any idea of what you want to incorporate it with, or why, or what to do with it. Can you explain, in detail, what it is you want?

 

[Dazzawm]

As I said the code deletes duplicate rows depending on what column I select. At the moment say there are 5 rows with the same data in column B it deletes 4 of them and whatever is in column X of the 4 deleted rows it it takes that and puts it in the the remaining row column X. I need the code to do the same with the data in columns S and V.

 

[Zack Barresse]

Still not following. You're not very detailed. If I am assuming correctly, then maybe something code after this line...

xcol(d(x)) = xcol(d(x)) & " " & xcol(i)

... like this ??? ...

Range("S:S")(d(x)) = Range("S:S")(d(x)) & " " & Range("S:S")(i)
Range("V:V")(d(x)) = Range("V:V")(d(x)) & " " & Range("V:V")(i)

Or, what I would probably do is use the iteration variable, which appears to be your row iteration, and use it with the Cells() method...

Cells(i, "S").Value = Cells(i, "S")(d(x)) & " " & Cells(i, "S").Value
Cells(i, "V").Value = Cells(i, "V")(d(x)) & " " & Cells(i, "V").Value

 

[Dazzawm]

I dont know how else I can explain it! I didnt write this code which is why I need help. I have 50,000 rows by say 30 columns. If any of the data in column B is the same then it deletes the duplicate rows. Columns S, V & X also have data which may all be different, so before the duplicated rows are deleted I need the data which is in the columns S,V & X held in a variable I suppose then put in the remaining row.

 

[Zack Barresse]

So in the rows of the column you select, when you find a duplicate (not the first unique found), then the values in columns S, V & X have something done to them. What do you want done to them? The value from the duplicated column appended to those values? Can you at least explain that? Perhaps with an example or two?

 

[Dazzawm]

So in the rows of the column you select, when you find a duplicate (not the first unique found), then the values in columns S, V & X have something done to them. What do you want done to them? The value from the duplicated column appended to those values? Can you at least explain that? Perhaps with an example or two?

If you see the example there are three rows with ABC in column B so it will delete 2 of them and leave the top row. In the 2 rows that are deleted there is data of 123, 456 in column S and BBB and CCC in column V, so those values need adding to their respective columns in the row thats left like in the 'After' below. The same is with the next 4 rows of DEF.

Sheet1

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 8px"><COL style="WIDTH: 88px"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"><COL style="WIDTH: 137px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD><TD>I</TD><TD>J</TD><TD>K</TD><TD>L</TD><TD>M</TD><TD>N</TD><TD>O</TD><TD>P</TD><TD>Q</TD><TD>R</TD><TD>S</TD><TD>T</TD><TD>U</TD><TD>V</TD><TD>W</TD><TD>X</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD>Before</TD><TD>ABC</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">123</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>AAAAA</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD> </TD><TD>ABC</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">123</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>BBB</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD> </TD><TD>ABC</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">456</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>CCC</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD> </TD><TD>DEF</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">456</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>DDDD</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD> </TD><TD>DEF</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">789</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>EEEEE</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD> </TD><TD>DEF</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD style="TEXT-ALIGN: right">789</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>GGGG</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD> </TD><TD>DEF</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD>After</TD><TD>ABC</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>123 123 456</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>AAAAA BBB CCC</TD></TR><TR style="HEIGHT: 18px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD> </TD><TD>DEF</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>456 789 789</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD>DDDD EEEE GGGG</TD></TR></TBODY></TABLE>

Excel tables to the web >> <a style ="font-family:Arial; font-size:9pt; color:#fcf507; background-color:#800040; font-weight:bold

 

[shg]

Try this:

Sub DelRows()
    Dim rUsed       As Range    ' used range
    Dim nRow        As Long     ' rows in used range
    Dim iRow        As Long     ' row index to used range
 
    Dim avB         As Variant  ' column B values
    Dim vB          As Variant  ' value from col B
    
    Dim rS          As Range    ' column S
    Dim rX          As Range    ' column X
    Dim rV          As Range    ' column V
 
    Dim abDup()     As Boolean  ' array for duplicates
    Dim rDup        As Range    ' range to paste duplicates
    Dim nDup        As Long     ' number of duplicates
    Dim dic         As Object   ' dictionary to detect duplicates
    
    Set rUsed = ActiveSheet.UsedRange
    nRow = rUsed.Rows.Count
 
    avB = Intersect(rUsed, Columns("B")).Value
    Set rS = Intersect(rUsed, Columns("S"))
    Set rX = Intersect(rUsed, Columns("X"))
    Set rV = Intersect(rUsed, Columns("V"))
 
    ReDim abDup(1 To nRow, 1 To 1)

    Set rDup = rUsed.Offset(, rUsed.Columns.Count + 1).Resize(, 1)
    Set dic = CreateObject("Scripting.Dictionary")
 
    For iRow = 1 To nRow
        vB = avB(iRow, 1)
        If dic.exists(vB) Then
            abDup(iRow, 1) = True
            nDup = nDup + 1
            Intersect(rUsed, Rows(dic(vB))).Interior.Color = vbCyan
            rS(dic(vB)).Value = rS(dic(vB)).Value & " " & rS(iRow).Value
            rX(dic(vB)).Value = rX(dic(vB)).Value & " " & rX(iRow).Value
            rV(dic(vB)).Value = rV(dic(vB)).Value & " " & rV(iRow).Value
        Else
            dic.Add Key:=vB, Item:=iRow
        End If
    Next iRow
 
    rDup.Resize(nRow).Value = abDup
    Cells.Sort Key1:=rDup(1), Order1:=xlDescending, _
               Header:=xlNo
 
    If nDup > 0 Then Rows(1).Resize(nDup).Delete
    rDup.EntireColumn.Delete

    ActiveSheet.UsedRange
End Sub

 

[Dazzawm]

Hooray!! That seemed to do it. Thanks all for your help.