Merging cells based on the merging in another column

[FrenchCelt]

Hello,

I have a macro that formats data to make it suitable for others to read. One thing I'm trying to add is the merging of cells in one column to match the same format in the column next to it. Basically the values in column B indicate the user name of an employee and the number of rows encompasses all the data of their productivity, and this range varies per person, so I can't use a constant value. I've attached an image of what I'm talking about. I want to merge the cells in column C to match the merging of the corresponding merged cells in column B so it looks like the next attached image. Can anyone provide some guidance?

 

[Micron]

How many user id's need to be merged and how often? If you had 500 I bet you could manually merge before anyone could write code from scratch for this (OK, at least that describes me). Unless maybe you could find something close that can be modified.

My approach might be to
- create an array of row numbers where id is located
- subtract pairs: 1st & second (4-6) and use absolute value (2) as x (or some variable)
- after each calc, for each array element (1st element is 4) = row 4. Select range: offset of 1 column by x rows and merge them
- rinse and repeat using next set of pairs (2nd & 3rd, then 3rd & 4th, etc. (6-9; 9-14; etc.)

I find that once you get into such things you find your idea has a lot of missing steps. I tend to over complicate things, so maybe someone will come along with a better (i.e. easier to code) idea; maybe even a formula.

 

[FrenchCelt]

This is a daily task across multiple reports and would be done thousands of times per week.

 

[shinigamilight]

Try this.

Sub wrw()
        Dim k, r   As Long
        Dim lr As Long: lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlWhole, xlByRows, xlPrevious).Row
        
        For k = lr To 1 Step -1
                If Range("C" & k).Value <> "" And Range("C" & k).Offset(0, -1).MergeCells = True Then
                    r = Range("C" & k).Offset(0, -1).MergeArea.Count
                    Range("C" & k).Resize(r, 1).Merge
                    Range("C" & k).VerticalAlignment = xlTop
                    Range("C" & k).HorizontalAlignment = xlCenter
                 End If
        Next k
 
End Sub

 

[FrenchCelt]

Thanks so much! Worked exactly as intended.