Searching for Data and then Merge across cells

[browncountry]

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Work Center[/TD]
[TD]Part Number[/TD]
[TD]Description[/TD]
[TD]Qty Good[/TD]
[TD]Qty Scrap[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD]Part A[/TD]
[TD]DescriptA[/TD]
[TD]20[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]Part B[/TD]
[TD]DescriptB[/TD]
[TD]5[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]5678[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD]Part C[/TD]
[TD]DescriptC[/TD]
[TD]56[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD]Part D[/TD]
[TD]DescriptD[/TD]
[TD]45[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD]Part E[/TD]
[TD]DescriptE[/TD]
[TD]90[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]9012[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD][/TD]
[TD]Part F[/TD]
[TD]DescriptF[/TD]
[TD]12[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

If anyone has time, I would like help with VBA to search for Work Centers in Column A and then merge that cell across to Column E.

The end result in my example is for my work centers to be headers of each group and centered across all columns. Work Center 1234 is merged from A3:E3; Work Center 5678 is merged from A6:E6; Work Center 9012 is merged from A10:E10.

I would also like to shade those merged cells to a light gray if possible. Thanks if you're able to help.

 

[Joe4]

It is highlly recommended to NOT merge cells, as merged cells are very problematic in Excel (see: https://www.atlaspm.com/toms-tutori...er-across-selection-instead-of-merging-cells/). The good news is that you can achieve the exact same visual effects as merging without merging, by using the "Center Across Selection" formatting option instead.

Here is VBA code that should do what you want:

Sub MyFormatting()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows starting at row 2
    For r = 2 To lr
'       See if column A is populated
        If Cells(r, "A") <> "" Then
'           Center across selection, columns A-E
            Range("A" & r & ":E" & r).HorizontalAlignment = xlCenterAcrossSelection
'           Shade to light gray
            Range("A" & r & ":E" & r).Interior.TintAndShade = -0.249977111117893
        End If
    Next r

    Application.ScreenUpdating = True
        
End Sub

If you want to choose a lighter shade of gray, just turn on your Macro Recorder, and record yourself shading some cell the color you want. Then stop the Macro Recorder, look at the code it recorded, and copy/replace the numeric color code over top the one in my code (the -0.249977111117893 number).

 

[browncountry]

Thank you so much Joe4! This was spot on and much appreciated. Thanks from the refresher about the problems of merging cells. Centering Across Selection is great. The shading; however, doesn't work but that's minor. I don't see the light gray. I even tried replacing it with a different color, but no luck.

 

[Joe4]

The shading; however, doesn't work but that's minor. I don't see the light gray. I even tried replacing it with a different color, but no luck.

It worked on mine.

Are you able to manually adjust the shading on those cells?
Do you have any Conditional Formatting rules applied that may be interfering with the code?

 

[browncountry]

I changed this line and added the ones below: Range("A" & r & ":E" & r).Interior.TintAndShade = -0.249977111117893

The items below gave me a light blue color and works for me.

Range("A" & r & ":E" & r).Interior.Pattern = xlSolid
Range("A" & r & ":E" & r).Interior.PatternColorIndex = xlAutomatic
Range("A" & r & ":E" & r).Interior.ThemeColor = xlThemeColorLight2
Range("A" & r & ":E" & r).Interior.TintAndShade = 0.799981688894314
Range("A" & r & ":E" & r).Interior.PatternTintAndShade = 0