(VBA) Search duplicates in column then work on whole rows

[sh1ne]

Hi Guys,
I will describe you my problem as far as I can. I need help with a macro which fill search for duplicates based on column D and IF THERE IS duplicated row, he will be always in next following row. Then all what we need to do is delete the duplicated rows, but add values from columns. There is no situation where the repeated row has a value in the column where the previous row has something in it. Let me show you my problem:

A	B	C	D
1			QWE
	2		WER
3			ERT
		4	ASD
	2		ASD
1			SDF
		2	DFG
		3	FGH
	1		FGH
2			FGH

<tbody>
</tbody>

How it should look after macro?

A	B	C	D
1			QWE
	2		WER
3			ERT
	2	4	ASD
1			SDF
		2	DFG
2	1	3	FGH

<tbody>
</tbody>

As you see, ASD and FGH values got before 2 and 3 same rows with different values in columns, macro should merge 'em all and put values in one line. All duplicates won't have values in column B if first not duplicated row has something in it.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG28Jun05
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("D1", Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
    .Add Dn.Value, Dn
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 1 To 3
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Offset(, -n).Value) [COLOR="Navy"]Then[/COLOR]
            .Item(Dn.Value).Offset(, -n).Value = Dn.Offset(, -n).Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick