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

BorisTheCat84

New Member
Joined
Apr 30, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,525
Office Version
  1. 2016
Platform
  1. Windows
I guess helpers here need samples with some explanation for clearer picture
 

BorisTheCat84

New Member
Joined
Apr 30, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
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
ABCDEFGH
1FruitCountryTypeShapeLengthWeightSugarColor
2AppleFranceMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
3AppleFranceMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
4AppleGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
5Apple?MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
6?MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
7Cherry?Whatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
8SwitzerlandSTANDARDWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this column
9OrangeSwitzerlandMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnOrange
10OrangeSwitzerlandMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnOrange
11BananaGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnYellow
12StrawberryGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
13BananaItalyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnYellow
14BananaItalyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
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):
FruitCountryTypeShapeLengthWeightSugarColor
AppleFranceMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this column
AppleGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
Apple?MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen
?MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
Cherry?Whatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
SwitzerlandSTANDARDWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this column
OrangeSwitzerlandMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnOrange
MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this column
BananaGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnYellow
StrawberryGermanyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnRed
BananaItalyMINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnYellow
MINORWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnWhatsoever value nothing should be done in the cells of this columnGreen


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

Cheers,
Boris
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,105
Office Version
  1. 365
  2. 2010
I kinda threw this together. Does this do what you meant?

Code:
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
 
Last edited:
Solution

BorisTheCat84

New Member
Joined
Apr 30, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Code:
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

New Member
Joined
Apr 30, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
It's not working on A2 A3 // B2 B3 & H2 H3 (they are supposed to merge)
Done worked, slight adjustment:

VBA Code:
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

New Member
Joined
Apr 30, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows

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

Cheers!
 

Forum statistics

Threads
1,141,073
Messages
5,704,138
Members
421,328
Latest member
mippy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top