Merge based on cell content macro

[doriannjeshi]

Hi,
I have this macro that merges column B cells, if column A cells are the same
Is possible to 1)change the range to be until the end of data in column A (not set like this Range("A2:A111150")
2)The merging to not include row 1 , as right now it merges the header too

Dim cellsA As Range
Dim i As Long
i = 1
For Each cellsA In ActiveSheet.Range("A2:A111150") 'expand range to your needs
If cellsA.Value <> cellsA.Offset(1, 0).Value Then
Range("B" & i & ":B" & cellsA.Row).Merge
i = cellsA.Row + 1

 

[MARK858]

if column A cells are the same

You're code says that it merges cells if Column A cell does not match Column A cell 1 row down

 

[doriannjeshi]

this is what it does:

Book1
	A	B
1	june	header
2	april
3	april
4	april
5	march
6	october
7	november
8	may
9	january
10	february
11	february
12	february
13	june
14	april
15
16	RESULTS
17	june	header
18	april
19	april
20	april
21	march
22	october
23	november
24	may
25	january
26	february
27	february
28	february
29	june
30	april
Sheet1

 

[MARK858]

I know what it does, the question is what do you want it to do as your description doesn't match the code.

 

[doriannjeshi]

Since it messes the header and the range is too long , I want to:
1)change the range to be until the end of data in column A (not set like this Range("A2:A111150")
2)The merging to not include row 1 , as right now it merges the header too

the headers are always in row 1

 

[MARK858]

Try

Sub xxxx()
    Dim cellsA As Range

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    For Each cellsA In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) 'expand range to your needs
        If cellsA.Value = cellsA.Offset(-1, 0).Value Then cellsA.Offset(-1, 1).Resize(2).Merge
    Next

    Application.DisplayAlerts = True

End Sub

 

[doriannjeshi]

Yes, great
Thank you Mark !

 

[MARK858]

You're welcome