VBA - Clear Duplicates and merge them by column // Empty cells should be ignored

[BorisTheCat84]

Hi Team,

I'm looking for a VBA Code that will clear duplicates by column (Column A, B & H) and merge the cleared cells.
If in the column there is empty rows, they should be ignored and not merged.
Can someone help me with the code?

Thanks

 

[Zot]

I guess helpers here need samples with some explanation for clearer picture

 

[BorisTheCat84]

Hi Team,
Apologies for the late reply but i had to gather the entire case scenario in order to narrow it properly.

Here is what's required:

Mr. Excel Version.xlsx
	A	B	C	D	E	F	G	H
1	Fruit	Country	Type	Shape	Length	Weight	Sugar	Color
2	Apple	France	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
3	Apple	France	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
4	Apple	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
5	Apple	?	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
6		?	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
7	Cherry	?		Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
8		Switzerland	STANDARD	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column
9	Orange	Switzerland	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Orange
10	Orange	Switzerland	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Orange
11	Banana	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Yellow
12	Strawberry	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
13	Banana	Italy	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Yellow
14	Banana	Italy	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
Sheet2

Column A should look for all duplicates in its cells and merge them on a condition that the content of the cells in Column B at the same row level can also be merged.

Column H should also look for all duplicates in its cells and merge them on a condition that Column A and Column B had cells that were merged at the same row level.

Below is the expected output (how the result should be):

Fruit	Country	Type	Shape	Length	Weight	Sugar	Color
Apple	France	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
		MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column
Apple	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
Apple	?	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green
	?	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
Cherry	?		Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
	Switzerland	STANDARD	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column
Orange	Switzerland	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Orange
		MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column
Banana	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Yellow
Strawberry	Germany	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Red
Banana	Italy	MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Yellow
		MINOR	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Whatsoever value nothing should be done in the cells of this column	Green

Hope this is clear now, your help will be truly appreciated in having the VBA Code for it.

Cheers,
Boris

 

[kweaver]

I kinda threw this together. Does this do what you meant?

Sub SpecMerge()
Dim lr As Long, i As Long, ct As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
' helper column
For i = 3 To lr
 Cells(i, "J") = Cells(i, "A") & Cells(i, "B")
Next i
 i = 3
Again:
 ct = WorksheetFunction.CountIf(Range("J3:J" & lr), Cells(i, "A") & Cells(i, "B"))
 If ct > 1 Then
  Range("A" & i + 1 & ":B" & i - 1 + ct).ClearContents
  Range("A" & i & ":A" & i - 1 + ct).Merge
  Range("B" & i & ":B" & i - 1 + ct).Merge
  Range("H" & i + 1 & ":H" & i - 1 + ct).ClearContents
  Range("H" & i & ":H" & i - 1 + ct).Merge
  i = i + ct
  If i < lr Then
  GoTo Again
  Else
  End If
 Else
 i = i + 1
 If i < lr Then
 GoTo Again
 End If
 End If
  Range("H:H").VerticalAlignment = xlCenter
 ' remove helper column
 Columns("J").EntireColumn.Delete
End Sub

 

[BorisTheCat84]

I kinda threw this together. Does this do what you meant?

Sub SpecMerge()
Dim lr As Long, i As Long, ct As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
' helper column
For i = 3 To lr
 Cells(i, "J") = Cells(i, "A") & Cells(i, "B")
Next i
 i = 3
Again:
 ct = WorksheetFunction.CountIf(Range("J3:J" & lr), Cells(i, "A") & Cells(i, "B"))
 If ct > 1 Then
  Range("A" & i + 1 & ":B" & i - 1 + ct).ClearContents
  Range("A" & i & ":A" & i - 1 + ct).Merge
  Range("B" & i & ":B" & i - 1 + ct).Merge
  Range("H" & i + 1 & ":H" & i - 1 + ct).ClearContents
  Range("H" & i & ":H" & i - 1 + ct).Merge
  i = i + ct
  If i < lr Then
  GoTo Again
  Else
  End If
 Else
 i = i + 1
 If i < lr Then
 GoTo Again
 End If
 End If
  Range("H:H").VerticalAlignment = xlCenter
 ' remove helper column
 Columns("J").EntireColumn.Delete
End Sub

It's not working on A2 A3 // B2 B3 & H2 H3 (they are supposed to merge)

 

[BorisTheCat84]

It's not working on A2 A3 // B2 B3 & H2 H3 (they are supposed to merge)

Done worked, slight adjustment:

For i = 2 To lr
 Cells(i, "J") = Cells(i, "A") & Cells(i, "B")
Next i
 i = 2
Again:
 ct = WorksheetFunction.CountIf(Range("J2:J" & lr), Cells(i, "A") & Cells(i, "B"))

 

[BorisTheCat84]

@kweaver - Thank you, for now it's doing what's supposed to do // will let you know if a strange behavior appears ​

Cheers!