# Merge duplicated cells in bulk per each column VBA

Need to merge data per column if records in the first column are the same.

I wrote a VBA code and it works but it works very slow as it executes "merge" function per each row no matter if consequent cells are the same or different.

Sub DuplicateValues()

'Declare All Variables:

Dim myCell As Range
Dim myRow As Integer
Dim myRange As Range
Dim myCol As Integer
Dim i As Integer
Dim k As Integer

Dim myFirstRow As Long
Dim myFirstColumn As Long

Dim rngCopy As Range, rngPaste As Range

'Count Number of Rows and Columns:

myRow = Range(Cells(3, 1), Cells(3, 1).End(xlDown)).Count + 2 'first two rows are headers
myCol = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Count

'Apply formatting to the end of the table:

With ActiveSheet
Set rngCopy = .Range(.Range("A3"), .Cells(myRow, myCol))

With rngCopy.Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With

'Merge duplicated cells per Row:

myFirstRow = 3
myFirstColumn = 1

Set iRow = Cells(myFirstRow, myFirstColumn)
Set n = Cells(myFirstRow + 1, myFirstColumn)

For i = 1 To myRow

If iRow <> n Then

Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).HorizontalAlignment = xlCenter
Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).VerticalAlignment = xlCenter
Range(Cells(myFirstRow, 8), Cells(myFirstRow, 8)).WrapText = True
Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).EntireRow.AutoFit

iRow = Cells(myFirstRow + i, myFirstColumn)
n = Cells(myFirstRow + i + 1, myFirstColumn)

Else
n = Cells(myFirstRow + i + 1, myFirstColumn)

For k = 1 To myCol - 3 'need to merge data per column but don't need to merge data in the last 3 columns

Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).Merge
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).HorizontalAlignment = xlCenter
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).VerticalAlignment = xlCenter
Range(Cells(myFirstRow + i - 1, 8), Cells(myFirstRow + i, 8)).WrapText = True
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).EntireRow.AutoFit

Next

End If
Next

End Sub


I tried to create a different logic to initiate "merge" by blocks (skip merging the same value cells in the first column right away):
merging only when the "base/initial" cell is not the same as a "check" cell and merge all appropriate cells all together (not by each row), but I can't find a way to make it work.

Would be very grateful for any code optimizations!

• Unrelated for performance, but avoid using With, it just obfuscates code and makes it less readable. – πάντα ῥεῖ Nov 22 '19 at 17:29

'Declare All Variables:

Dim myCell As Range
Dim myRow As Integer
Dim myRange As Range
Dim myCol As Integer
Dim i As Integer
Dim k As Integer

Dim myFirstRow As Long
Dim myFirstColumn As Long

Dim rngCopy As Range, rngPaste As Range


Don't do this. This procedure is somewhere between 2 and 3 screens high on my laptop: when I'm at the bottom of the procedure, I don't know what I'm looking at, so I scroll back up to this wall of declarations, parse the chunk of code, locate the variable I'm looking for, then scroll back down to where I was, ...and that gets very annoying, very fast.

People defending this "declare everything at the top of the procedure" habit usually defend it pretty hard, and they're wrong. "I can see everything that's used in the procedure at once" sounds great on paper. Truth is, it only makes you scroll back and forth all the time for no reason, and makes it much harder than it should be, to know whether or not a variable is used, let alone where it's used.

If you declare variables where you first assign them, as you need to introduce them, then you simply can't miss the fact that myCell, myRange, rngPaste are never assigned or referenced anywhere... and that iRow and n aren't declared at all. This is extremely bug-prone, you don't want to allow VBA code to run with undeclared variables. Fortunately you can completely prevent this, by simply specifying Option Explicit at the very top of every module you ever write any VBA code in.

Proper indentation also helps, massively. It started well:

For i = 1 To myRow

If iRow <> n Then


...and then suddenly went way out there:

                Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).HorizontalAlignment = xlCenter


...to seemingly random:

            Else
n = Cells(myFirstRow + i + 1, myFirstColumn)

For k = 1 To myCol - 3 'need to merge data per column but don't need to merge data in the last 3 columns


Use an indenter if you're unsure how to keep indentation consistent.

Row numbers should always be As Long. An Integer is a 16-bit signed integer type, so its maximum possible value is 32,767. This means as soon as your data involves row 32,768 and beyond, your code breaks with an "Overflow" run-time error. In fact, there's little to no reason at all to ever declare anything As Integer in 2019: processors are optimized to deal with 32-bit integer types, and that's a Long in VBA.

I like this:

With ActiveSheet


I makes ActiveSheet references explicit, and that's very good.

However you're implicitly referring to whatever the ActiveSheet is everywhere else outside this With block.

myRow = Range(Cells(3, 1), Cells(3, 1).End(xlDown)).Count + 2 'first two rows are headers
myCol = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Count


Unqualified like this, Range and Cells are implicitly referring to the ActiveSheet: the With ActiveSheet block is therefore redundant, and makes accesses to that active sheet inconsistent: some are explicit, some are implicit - and that's very bug-prone.

myRow = Range(Cells(3, 1), Cells(3, 1).End(xlDown)).Count + 2 'first two rows are headers


Looks like you're trying to get the last used row; this is not a reliable way to do it. Consider flipping the logic around and going up from the last row on the sheet to get the .Row of that specific cell, rather than the Count of cells in a range:

myRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row


Note how the fist two rows being headers, doesn't matter any more.

I'd strongly advise against using my as a prefix for anything, regardless of how often you see it in documentation. Same goes for rng and o and whatever other prefixing scheme you might read anywhere. Use meaningful names instead. "myRow" doesn't say what's important about it: it's the last row with data. lastRow would already be a much better name for it.

rngCopy is assigned, its borders are formatted, ...but it's not being copied anywhere. The name strongly suggests it's a source, especially since it's declared right next to the unused rngPaste, which strongly suggests that would be a destination for an operation involving the clipboard. Pretty misleading, since none of that is happening anywhere in the procedure.

I already mentioned n isn't declared. Its usage is a problem.

Set n = Cells(myFirstRow + 1, myFirstColumn)


It's Set-assigned to a Range. Thus, its runtime type at that point is Variant/Range.

If iRow <> n Then


Now it's being compared to iRow, which is another undeclared Variant/Range variable, and the two objects are only comparable through implicit let-coercion involving hidden default member calls - making it all explicit would look like this:

If iRow.Value <> n.Value Then


And while that's now explicit, it's wrong. It's wrong, because they shouldn't be Range objects. They shouldn't be Range objects, because they're later being Let-assigned to plain values:

        iRow = Cells(myFirstRow + i, myFirstColumn)
n = Cells(myFirstRow + i + 1, myFirstColumn)


Beyond that point, the data type of iRow and n is up in the air. If you're lucky, you're looking at two Variant/Double values. Otherwise, you're looking at one or more Variant/Error values (that would be the case if the worksheet contains error values), and everything blows up with a type mismatch error.

Not declaring variables is one thing, reusing variables is another, but reusing undeclared variables and assigning them a new runtime type, makes everything very hard to follow. Declare them with an explicit data type, and let them be values, instead of objects that behave like values thanks to implicit hidden code.

As for performance, the reason it's slow is because it's doing the single slowest thing any code can do: interact with worksheet cells directly, in a loop.

You can't help it, interacting with worksheet cells is precisely what this macro needs to do. All you can do is tell Excel to stop trying to keep up as you modify the worksheet.

Every time a cell is modified, Excel evaluates whether a recalc is needed, and will perform it if it has to. Switch calculation to manual before you start manipulating the worksheet, and toggle it back to automatic when you're done: Excel will only recalculate once. That's Application.Calculation (set to xlCalculationManual, then back to xlCalculationAutomatic when you're ready).

Every time a cell is modified, Excel fires worksheet events (e.g. Worksheet.Change), and if there's a handler procedure for that event, then that code will run before the next instruction does. Turn off application events before you start manipulating the worksheet, and toggle it back on when you're done: no worksheet events will be fired; that's Application.EnableEvents (set to False, then back to True when you're ready).

Every time a cell is modified, Excel tries to repaint itself. While that's normally pretty fast, when you're modifying cells in a loop you don't want Excel to even try to keep up - you want to make your changes, and have Excel repaint itself when you're done. Do that by toggling Application.ScreenUpdating (set to False, then back to True when you're ready).

Whenever you toggle this global Application state, make sure you handle runtime errors, and have your error-handling subroutine ensure that the global state gets properly reset whether the procedure succeeds or fails, whatever the reason for failing might be.

• Thanks for the detailed explanations on my errors, I just started writing codes on VBA and this is very helpful! Regarding performance, don't you think that if other logic was used, like merging only duplicated cells that are following each other (skipping merging every row) would increase the speed? I just don't know how to make it works that way... – Art Nov 22 '19 at 20:46
• It probably would, but I'm pretty sure the overhead of Excel recalculating and redrawing stuff every time dwarfs any algorithmic tweaks - best do both (turn off recalcs & repaints and review the algorithm) – Mathieu Guindon Nov 22 '19 at 21:11
• Another question is about myRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row that's a great way of getting the last row but I'm now getting an error: Object variable or With block variable not set – Art Nov 22 '19 at 21:13
• Is ws defined? I only put it there to emphasize that Range is a member call that needs to be qualified with a proper Worksheet object. – Mathieu Guindon Nov 22 '19 at 21:14
• Yes, I defined ws: Dim ws As Worksheet – Art Nov 22 '19 at 21:19

I tried to create a different logic to initiate "merge" by blocks (skip merging the same value cells in the first column right away):

The best way to do this is count the number of duplicates and then define your range as current row to (current row - (number of duplicates + 1)) (note: you add 1 because the original value is not a duplicate).

Range(Cells(i - (countDups + 1), k), Cells(i, k))


Hard coded values that may change in the future are called Magic Numbers. Replacing these values with an enumeration or constants will make you code easier to read and modify.

For example the number 3 appears appears 4 times in code. Each occurrence is being used to determine the number of columns to exclude. If you later decide that you only need to exclude a 2 columns, you could just change all the 3's to 2. No problem, ease pease. So let's say we did that but decided to we did indeed need the to exclude the 3rd column, no problem just replace the 2's with 3's. But wait there are 2 header rows, now there is a problem.

Before

Cells(myFirstRow, myCol - 3)


After

Cells(myFirstRow, myCol - ColumnOffset)


Anything that is in going to happen If or Else does not belong in an If statement.

If iRow <> n Then

Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).HorizontalAlignment = xlCenter
Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).VerticalAlignment = xlCenter
Range(Cells(myFirstRow, 8), Cells(myFirstRow, 8)).WrapText = True
Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).EntireRow.AutoFit

iRow = Cells(myFirstRow + i, myFirstColumn)
n = Cells(myFirstRow + i + 1, myFirstColumn)

Else
n = Cells(myFirstRow + i + 1, myFirstColumn)

For k = 1 To myCol - 3 'need to merge data per column but don't need to merge data in the last 3 columns

Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).Merge
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).HorizontalAlignment = xlCenter
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).VerticalAlignment = xlCenter
Range(Cells(myFirstRow + i - 1, 8), Cells(myFirstRow + i, 8)).WrapText = True
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).EntireRow.AutoFit

Next

End If


The k loop is disguising the fact that the HorizontalAlignment, VerticalAlignment and row height are being adjusted whether iRow <> n or not. Knowing this we can move these operations outside the scope of the If statement. This will make it much easier to focus on the if...Else logic.

If iRow <> n Then
iRow = Cells(myFirstRow + i, myFirstColumn)
Else
For k = 1 To myCol - 3
Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).Merge
Next
End If

n = Cells(myFirstRow + i + 1, myFirstColumn)
Range(Cells(myFirstRow, 8), Cells(myFirstRow, 8)).WrapText = True
With Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.EntireRow.AutoFit
End With


If we think about it a little deeper, these formats are being applied to all cells in our target area. The formatting isn't even essential to merging the cells, which is what we are really trying to do. So we could simply pass the area to be formatted to another subroutine (see code below). This will simplify the main code and make it much easier to focus on the task at hand.

## Refactored Code

Sub MergeDuplicateValues()
Const DebugMode As Boolean = True

Dim Target As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Data")

If DebugMode Then
Rem Close previous test workbook
CloseTestWorkbooks
Rem Copy the worksheet to a new workbook
ws.Copy
Set ws = ActiveSheet
End If

Rem Define the Target Range
Set Target = getMergeRange(ws.Range("A1"))
Rem Add breakpoint here and use Target.Select in the Immediate Window to test the range

If Target Is Nothing Then Exit Sub

Application.ScreenUpdating = False
MergeDuplicates Target
ApplyBorders Target.CurrentRegion
ApplyFormatsToMergeArea Target

End Sub

Private Sub MergeDuplicates(Target As Range)
Dim r As Long, countDups As Long

With Target
For r = 1 To .Rows.Count
If .Cells(r, 1).Value = .Cells(r + 1, 1).Value Then
countDups = countDups + 1
Else
If Count > 0 Then
Dim Column As Range

Rem Iterate over each column of the Target Range
For Each Column In .Columns
Dim section As Range
Set section = Column.Cells(r - countDups, 1).Resize(countDups + 1)

Rem Add breakpoint here and use section.Select in the Immediate Window to test the range
section.Merge
Next
Count = 0
End If
End If
Next
End With
End Sub

Private Function getMergeRange(Target As Range) As Range
Const LastColumnOffset As Long = -3
Const FirstRowOffset As Long = 2

Dim newTarget As Range
With Target.CurrentRegion

Rem An error handler is needed when setting a range using negative offsets
On Error Resume Next

Rem Define the actual Target range
Set newTarget = .Offset(FirstRowOffset).Resize(.Rows.Count - FirstRowOffset, .Columns.Count + LastColumnOffset)

Rem Add breakpoint here and use newTarget.Select in the Immediate Window to test the range

If Err.Number <> 0 Then
Err.Raise Number:=vbObjectError + 513, Description:="Unable to create Merged Range"
Exit Function
End If
On Error GoTo 0
End With

Set getMergeRange = newTarget
End Function

Private Sub ApplyBorders(Target As Range)
With Target.Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End Sub

Private Sub ApplyFormatsToMergeArea(Target As Range)
Const NumberOfColumns As Long = 8

With Target
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Resize(, NumberOfColumns).WrapText = True
.Rows.EntireRow.AutoFit
End With
End Sub

Private Sub CloseTestWorkbooks()
Dim wb As Workbook
For Each wb In Workbooks
If Len(wb.Path) = 0 Then wb.Close 0
Next
End Sub