Merge and centre current row with next blank row if value is "Open" in column "A". VBA Program

Akash030193

New Member
Joined
Apr 28, 2019
Messages
22
I want to Merge and centre current row (row 2) with next blank row (row 3) if value is "Open". Similarly for other rows (6-7, 8-9, 10-11 etc.)

Can you please provide any suitable VBA Program?


[TABLE="class: grid, width: 0, align: center"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Status[/TD]
[TD]remark[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Close[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Close[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Close[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
@Akash030193...

Will there ever be any blanks in Column A under the word "Close"? In other words, if I see a blank cell in Column A, can I assume the the first cell with text above it will always contain the word "Open" as your posted example seems to show?
 
Last edited:
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
NO. I think my interpretation is difficult to understand. Let me explain you once again with new example:

Can you make me a program that can
merge "open" comment with next blank cell, even if the cell with "open" valve is merged with end number of rows, or not.

Please note C column is for remark only


[TABLE="class: cms_table_grid, align: center"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C
remark[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Open[/TD]
[TD]as[/TD]
[TD]row 1-2 already merged[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD]ad[/TD]
[TD]row 1-2 already merged[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]af[/TD]
[TD]This row (cell A3) To be merged with 1-2 (Cell A1-A2)[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Open[/TD]
[TD]as[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]df[/TD]
[TD]This row (cell A5) To be merged with 4 (Cell A4)[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Close[/TD]
[TD]vr[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Open[/TD]
[TD]vf[/TD]
[TD]row 7-8-9-10 already merged[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD]row 7-8-9-10 already merged[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD][/TD]
[TD]row 7-8-9-10 already merged[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD]row 7-8-9-10 already merged[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[TD]This row (cell A11) To be merged with 7-8-9-10 (Cell A7 to A10)[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]Close[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Yes, you are right. Currently I am working as a client in engineering company. When I receive any response from vendor against our comment, if vendor has not incorporated our comment then we add row, merge row, and add comment in respective column with "open" remark. If vendor has incorporated the comment then we put "close" remark only.

I have got program to add row where open comment is found, but I am looking for a program where I can merge the next blank row with Open remark comments.
 
Upvote 0
Yes, you are right.
This code should handle all merges for you (whether the first time or when additional cells have to be added to existing merged cells). Give it a try and let me know...
Code:
Sub OpenMerge()
  Dim Ar As Range
  Columns("A").UnMerge
  For Each Ar In Intersect([A:A], ActiveSheet.UsedRange).SpecialCells(xlBlanks).Areas
    Ar(1).Offset(-1).Resize(Ar.Count + 1).Merge
  Next
End Sub
 
Upvote 0
Thanks Michael,

Your program is working well. But further to your macro program. I need your help on below query!
I want to Merge and centre current merged row (row 2-3) with next blank row (row 4) if value is "Open" (merged row 2-3). Similarly for other rows (6-7, 8-9-10-11 etc.).

In short, I need to merge "open" comment with next blank cell even if the cell with "open" valve is merged or not.


Can you please provide any suitable VBA Program?

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Open (row 2 and 3 are merged)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Open (row 2 and 3 are merged)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Close[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Open[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Open (row 8-9-10 merged)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Open (row 8-9-10 merged)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Open (row 8-9-10 merged)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]close[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]close[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]close[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Thanks in advance :)

this is what you asked for and that makes my macro, but if you are going to change the rules at every moment, the same macro will not work for the new rules.
 
Upvote 0
Then, try this please.

And in case there are blank spaces under "close", it also works.

Code:
Sub merge_cell_2()
    Dim c As Range, ini As Long, wopen As Boolean
    
    ini = 1
    wopen = False
    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If UCase(c.Value) = UCase("Open") Then
            If wopen <> False Then Range("A" & ini & ":A" & c.Row - 1).Merge
            ini = c.Row
            wopen = True
        Else
            If c.Value <> "" And ini <> 0 Then
                Range("A" & ini & ":A" & c.Row - 1).Merge
                wopen = False
                ini = 0
            End If
        End If
    Next
End Sub
 
Upvote 0
Dear DanteAmor,

Thanks you very very much!:):):)

Your program is working well, it will reduce my efforts in merging cells with "Open" comment especially. Thanks you once again:rolleyes:

Regards,
Akash Patel
 
Upvote 0
Rick Rothstein,

Thanks you very very much!:):):)

Your program is also working well, it will reduce my efforts in merging cells with "Open" comment especially. Thanks you once again:rolleyes:

Regards,
Akash Patel
 
Upvote 0

Forum statistics

Threads
1,224,766
Messages
6,180,846
Members
453,001
Latest member
coulombevin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top