Comparing one column of data and merging rows based on contents

[mhorstman]

Hi,

I'm trying to have my sheet look at data in column A, find duplicates, and merge cells in column U,V, and W based on the number of rows with matching data. So if A5:A9 match, then U5:U9 merge, V5:V9 merge, and W5:W9 merge. I can get it to work for one row but I'm missing a step somewhere for it to cycle through the full list. I'm using Excel 2016. Appreciate any help.

There is some extra code in the comments below based on another way that it was being used before (the page would sort and then it would only display the sorted data and merge those cells). That worked great, now we need it to look at everything instead of just the filtered data.

Thanks!

Private Sub Worksheet_Activate()
'Merge and center cells based on patient EMP ID
On Error Resume Next
Dim sh1 As Worksheet: Set sh1 = ThisWorkbook.ActiveSheet
'Dim empid As Range: Set empid = sh1.Cells(2, 5)
Dim lastr As Variant: lastr = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
'Dim EmpRange As Range: Set EmpRange = sh1.Range(sh1.Cells(4, 1), sh1.Cells(lastr, 1))
Dim r As Range
Dim LastRow As String
Dim FirstRow As String
'Dim totalr As Integer: totalr = sh1.Application.WorksheetFunction.CountIf(EmpRange, empid)
Dim totalr As Integer: totalr = sh1.Application.WorksheetFunction.CountIf(lastr, 1)
Dim lastrad As String
lastrad = "A" & lastr
'Set r = sh1.Range("A3:" & lastrad).Find(empid.Value, lookat:=xlValue)
Set r = sh1.Range("A4:" & lastrad)
r.RemoveDuplicates
Dim a As Range
Set a = Application.WorksheetFunction.Index(r, Application.WorksheetFunction.Match(0, sh1.Range(sh1.Cells("A4:", lastr), 0)))
Dim c As Range
For Each c In a
FirstRow = r.Row
LastRow = r.Offset(rowoffset:=totalr - 1).Row
With sh1
.Range(.Cells(FirstRow, 21), .Cells(LastRow, 21)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 21), .Cells(LastRow, 21)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 21), .Cells(LastRow, 21)).Merge
.Range(.Cells(FirstRow, 21), .Cells(LastRow, 21)).Borders.Weight = xlMedium
.Range(.Cells(FirstRow, 22), .Cells(LastRow, 22)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 22), .Cells(LastRow, 22)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 22), .Cells(LastRow, 22)).Merge
.Range(.Cells(FirstRow, 22), .Cells(LastRow, 22)).Borders.Weight = xlMedium
.Range(.Cells(FirstRow, 23), .Cells(LastRow, 23)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 23), .Cells(LastRow, 23)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 23), .Cells(LastRow, 23)).Merge
.Range(.Cells(FirstRow, 23), .Cells(LastRow, 23)).Borders.Weight = xlMedium
.Range(.Cells(FirstRow, 24), .Cells(LastRow, 24)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 24), .Cells(LastRow, 24)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 24), .Cells(LastRow, 24)).Merge
.Range(.Cells(FirstRow, 24), .Cells(LastRow, 24)).Borders.Weight = xlMedium
.Range(.Cells(FirstRow, 25), .Cells(LastRow, 25)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 25), .Cells(LastRow, 25)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 25), .Cells(LastRow, 25)).Merge
.Range(.Cells(FirstRow, 25), .Cells(LastRow, 25)).Borders.Weight = xlMedium
.Range(.Cells(FirstRow, 26), .Cells(LastRow, 26)).HorizontalAlignment = xlCenter
.Range(.Cells(FirstRow, 26), .Cells(LastRow, 26)).VerticalAlignment = xlCenter
.Range(.Cells(FirstRow, 26), .Cells(LastRow, 26)).Merge
.Range(.Cells(FirstRow, 26), .Cells(LastRow, 26)).Borders.Weight = xlMedium
End With
Next c
End Sub