Merging Cells

[ab304]

Hi,

I have a sheet in which I want to find certain text in VBA, for example "TEST" in a cell in column A.

Once I have found the cell containing the text I then want to merge that cell with all the cells to the right up to column H.

Dim l As Long
    l = Application.WorksheetFunction.Match("TEST", Range("A1:A100"), 0)

I know how to find the cell which contains the text but then I'm unsure how to merge with the next 7 cells to the right of it.

Help much appreciated.

Ab304

 

[Ruddles]

Following on from your code:-

    Application.DisplayAlerts = False
    Range("A" & l & ":H" & l).Merge
    Application.DisplayAlerts = True

You need to turn alerts off otherwise you get a warning about merging cells with multiple values in them.

Note that the word "TEST" is still in column A so if you run the code again, it will find the same row again rather than finding the word in a subsequent row.

 

[MrKowz]

I'd highly recommend, instead of merging, to format with "Center Across Selection". Since you are using VBA code in this worksheet, merged cells can cause some severe issues in the future (VBA and Merged cells go together about as good as oil and water).

 

[ab304]

I'd highly recommend, instead of merging, to format with "Center Across Selection". Since you are using VBA code in this worksheet, merged cells can cause some severe issues in the future (VBA and Merged cells go together about as good as oil and water).

Hi MrKowz & Ruddles

Thanks for your helpd - I'm not familar with Center Across Selection, how would I work that in?

I've come up with the below as a way to accomplish what I'm after as I'm not just looking for the word test, but any cell that contains the word milestone. It works, but is there a better way to do it (i.e. without using merge?)

Range("A1:A5000").Select
For Each rw In Selection.Rows
If InStr(1, Cells(rw.Row, 1).Value, "Milestone") > 0 Then 
Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).Merge
Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).HorizontalAlignment = xlCenter
Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).VerticalAlignment = xlTop
End If
Next rw

 

[Ruddles]

My original suggestion was an attempt to provide you with the code to do exactly what you requested rather than advise you how to design a spreadsheet. However I do agree with MrKowz: merged cells can be a real nuisance if you're doing anything more complicated than merely typing values into cells, and most Excel work is more complicated than that.

I think 'center across selection' came in with 2007 (?), but if it's in your drop-down list for setting the horizontal alignment (Format Cells... > Alignment), you could try replacing this:-

Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).Merge
Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).HorizontalAlignment = xlCenter

with this:-

Range(Cells(rw.Row, 1), Cells(rw.Row, 7)).HorizontalAlignment = xlCenterAcrossSelection

 

[MrKowz]

Give this a shot:

Public Sub CenterValues()
Dim rng     As Range, _
    rng1    As Range, _
    LR      As Long
    
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:A" & LR)
    Set rng = .Find("Milestone", LookIn:=xlValues, lookAt:=xlPart)
    If Not rng Is Nothing Then
        rng1 = rng.Address
        Do
            rng.Resize(1, 7).HorizontalAlignment = xlCenterAcrossSelection
            Set rng = .FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> rng1
    End If
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub