Macro --- Combine Duplicates --- Delete Row --- Update Column

**hftechno** · 04-29-2015, 05:21 PM

I have attached an example.
-----------------------------------

1. Looking for a Macro that will find duplicates based upon column C D &E
2. Combine the Duplicates to one line and delete the other rows
3. During the consolidation process IF Column A contains the word "Upd" the resulting Column A is Renamed as Upd ELSE it remains "ADD"

Thanks so much in advance!!!!!

**ARowbot** · 04-29-2015, 05:40 PM

Answered my own question by looking at the after bit...Ooops!

**ARowbot** · 04-29-2015, 06:18 PM

Try this:

Sub Carrots()
Dim lr As Integer
Dim c, e As Integer
Dim d As String
Dim Rng As Range
Dim Upd As Boolean

lr = Sheets("Sheet1").Range("C" & Rows.Count).End(3).Row
Set Rng = Range("C2:C" & lr)

For Each mycell In Rng
    With mycell
        c = .Value
        d = .Offset(, 1).Value
        e = .Offset(, 2).Value
    End With
    
    If Cells(mycell.Row, "A") = "Upd" Then
        Upd = True
    Else
        Upd = False
    End If

    For r = mycell.Row + 1 To Range("C" & Rows.Count).End(3).Row
        If Cells(r, "C") = c And Cells(r, "D") = d And Cells(r, "E") = e Then
            If Cells(r, "A") = "Upd" Then Upd = True
            mycell.Offset(, 6) = mycell.Offset(, 6).Value + Cells(r, "I").Value
            Rows(r).Delete
            r = r - 1
        End If
    Next r

    If Upd Then
        Cells(mycell.Row, "A") = "Upd"
    Else
        Cells(mycell.Row, "A") = "Add"
    End If
Next mycell
End Sub

**jindon** · 04-29-2015, 07:53 PM

Try

Sub test()
    Dim a, i As Long, x As Range, txt As String, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Application.ScreenUpdating = False
    a = Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        txt = Join(Array(a(i, 3), a(i, 4), a(i, 5)), Chr(2))
        If Not dic.exists(txt) Then
            dic(txt) = i
        Else
            If x Is Nothing Then
                Set x = Rows(i)
            Else
                Set x = Union(x, Rows(i))
            End If
            If a(i, 1) = "Upd" Then Cells(dic(txt), 1).Value = "Upd"
            Cells(dic(txt), 9).Value = Cells(dic(txt), 9).Value + a(i, 9)
        End If
    Next
    If Not x Is Nothing Then x.Delete
    Application.ScreenUpdating = True
End Sub

**hftechno** · 04-30-2015, 10:41 AM

You are indeed correct that was my mistake. I have one final question then...

I have attached another sheet with an additional tab with my actual data. it runs fine on the "Example Tab" but on my "Actual Tab" I get a type mismatch error.

I changed the lr = Sheets("Actual") ???

**hftechno** · 04-30-2015, 02:20 AM

I just tested it...... ARowbot this looks AWSOME my friend!!!! The only thing I see off is the first line of the results. It should be...

------------------------------------------------------------------------------
Upd DATA 2251 102828-2208D 5 2015 4 KG 3672 0 0
------------------------------------------------------------------------------

But its not applying the code to the first set...

Upd DATA 2251 102828-2208D 5 2015 4 KG 1836 0 0
Add DATA 2251 102864-2208D 5 2015 4 KG 1836 0 0

**ARowbot** · 04-30-2015, 02:51 AM

You're very welcome...I noticed this...And this is because Column D is not identical. You asked for duplicates on all 3 columns...

**hftechno** · 04-30-2015, 10:47 AM

If I step through it. It runs for a few lines then errors out.

**ARowbot** · 04-30-2015, 11:21 AM

This is because in row 163 you have #N/A which is causing the mismatch. Should this value actually be in there?

**hftechno** · 04-30-2015, 11:49 AM

That was it. Thank You for your prompt and concise responses!!!!!!!!!!!

Macro --- Combine Duplicates --- Delete Row --- Update Column

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Re: Macro --- Combine Duplicates --- Delete Row --- Update Column

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Formula needed to combine, not delete, multiple rows if duplicates found in column A

Macro to combine cells and then delete duplicates......

[SOLVED] Macro to combine cells and then delete duplicates......

[SOLVED] Macro to count unique values in a column, enter it in next column, then delete duplicates

combine row and the delete duplicates

Bookmarks

Bookmarks

Posting Permissions