Excel Visual Basic Macro to merge cells in a selected area

Question

I have an excel spreadsheet where I want to merge each cell with a value in it with every empty cell below it until the next cell in that column with a value.

Currently I have this:

Sub mergemainbody()    
    lrow = ActiveSheet.UsedRange.Rows.Count - 2        
    On Error Resume Next  
    Application.DisplayAlerts = False  
    For col = 1 To 50  
       For Each ar In Cells(3, col).Resize(lrow).SpecialCells  (xlCellTypeBlanks).Areas  
          ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge  
       Next  
    Next  
 End Sub

Which works on an entire sheet, but I want the macro to only apply to a selected area. However, simply changing For col = 1 to 50 to For Each cell In Selection makes the macro seemingly do nothing.

Example of data:

Heading | Heading   | Heading   | Heading   |      
1456262 | 270520    | 574038    | 583059    |    
Words   | --------- | --------- | --------- |  
586048  | --------- | --------- | --------- |        
Words   | 694574    | 856738    | 068438    |

Where --- shows the cell is empty.

Can you elaborate on _stop working_ how does it stop working, does it do nothing, do you get an error code or anything? — litelite, Sep 06 '16 at 14:52
Have you tried setting a range based on your selection first and then looping through that range? — CallumDA, Sep 06 '16 at 14:52
@CallumDA33 My problem is that ideally I would want my coworkers to use this macro for different areas as more data is added to the spreadsheet, so I wouldn't want it to only be for a set area if that makes sense? Or did I misunderstand your question? — Elin B, Sep 06 '16 at 14:55
The `For Each Cell in Selection` isn't working, since you never selected anything (which is a [good thing](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). Take out `On Error Resume Next`, and it'll throw an error if there is one. Let us know what that error is, and where. You're probably not getting the ranges you want with `.Areas` too, as that has happened to me. Could you post some mock-data, so we can see how your data is laid out? — BruceWayne, Sep 06 '16 at 14:58
@BruceWayne If I get rid of On Error Resume Next, I just get an error box which only says '400'. Not sure how to post information such that the spacing works, but I'll try adding some to the question! — Elin B, Sep 06 '16 at 15:00
Hm, that's odd. If I take it out, I don't get a `400` error. I get an ` object defined error` at the `In Cells(3, col).Resize(lrow, 0).SpecialCells(xlCellTypeBlanks).Areas` line. What does your data look like? The Range + resize with .Areas is a little convoluted - what does is that range supposed to be? — BruceWayne, Sep 06 '16 at 15:03
@BruceWayne Added some example data now, hope that makes things a little clearer. Also I retried to run it and this time also got an object defined error. — Elin B, Sep 06 '16 at 15:11
Oh! Are you just trying to copy data down a column, then go to the next column? So you'd want the `-----` cells to have the data above them? — BruceWayne, Sep 06 '16 at 15:13
@BruceWayne No, I would want the --- cells to be merged with the cell above which has data in — Elin B, Sep 06 '16 at 15:13
Ah, okay. Just FYI - are you *sure* you want to merge cells? It can make it harder down the road to work with your data. I tried your code, and it worked for me. Note that I had to declare the variables. Add `Option Explicit` to the very top (above `Sub ...`), then add `Dim lRow as Long, col as Long, ar as Range`. See if the code works then. — BruceWayne, Sep 06 '16 at 15:14
@BruceWayne Unfortunately yes I no need to merge - I also think it's a bad idea but I didn't get to choose sadly. Did you try it with 'Each Cell in Selection' or 'col = 1 to 50'? — Elin B, Sep 06 '16 at 15:17

score 1 · Accepted Answer · answered Sep 06 '16 at 15:28

1

Here is a rough way to merge down on your selection as you requested. Note that this won't work the way you intend if there isn't a value in the first cell

Sub MergeDown()
    Dim rng As Range, r As Range
    Dim i As Integer

    Set rng = Selection
    For Each r In rng
        If r.Value <> "" Then
            i = 1
            While r.Offset(i, 0).Value = "" And Not Intersect(r.Offset(i, 0), rng) Is Nothing
                i = i + 1
            Wend
            r.Resize(i, 1).Merge
        End If
    Next r
End Sub

answered Sep 06 '16 at 15:28

CallumDA

12,025
6
30
52

Thanks! Very helpful – Elin B Sep 06 '16 at 15:31
1

@ElinB - Please note though, your main original error was caused because you weren't declaring your variables correctly (or at all). This solution of course works, but don't let that fact go ignored. Make sure to always declare your variables. I suggest always adding `Option Explicit` to your code, to ensure they're declared. – BruceWayne Sep 06 '16 at 16:23

score 1 · Answer 2 · answered Sep 06 '16 at 15:39

I will assume that you do not want to ever merge the second row with the header row.

After isolating row 3 to the last used row in the data block radiating out from A1 with the Range.CurrentRegion property and the Range.Resize / Range.Offset properties, use the Range.SpecialCells method with xlCellTypeBlanks. As you cycle through the Range.Areas property, resize and offset before merging.

Dim c As Long, a As Long
With ActiveSheet
    'work on the block of data radiating out from A1
    With .Cells(1, 1).CurrentRegion
        'move off the header row and first row of data
        With .Resize(.Rows.Count - 2, .Columns.Count).Offset(2, 0)
            'work through the columns
            For c = 1 To .Columns.Count
                'locate the blank cells in groups (aka Areas)
                With .Columns(c).Cells.SpecialCells(xlCellTypeBlanks)
                    'cycle through the areas (blank cell groups)
                    For a = 1 To .Areas.Count
                        'work with each Area in turn
                        With .Areas(a).Cells
                            'resize one row larger and offset one row up
                            .Resize(.Rows.Count + 1, 1).Offset(-1, 0).Merge
                            'optionally center the value in the newly merged cells
                            .VerticalAlignment = xlCenter
                        End With
                    Next a
                End With
            Next c
        End With
    End With
End With

Do you find `CurrentRegion` to work well enough, to use often? How does it decide what the `CurrentRegion` is? Is it an alternative to `.Selection` in this case? Or will it essentiall do `.End(xlRight)` for column range, and `.End(xlDown)` for the last row? — BruceWayne, Sep 06 '16 at 16:21
I use it very often whenever there is an 'island' of data. From the origin point, the .CurrentRegion radiates out in all directions until it encounters the end of the worksheet, a completely blank row or a completely blank column. There can be blank cells within hte current region but not a completely blank row or column. It can be manually simulated by tapping [ctrl]+A once. — , Sep 06 '16 at 16:56

BruceWayne · Answer 3 · 2016-09-06T15:27:30.163

0

I believe your problem is that the Variables were never declared, so VBA is making a guess at what they are. Use this code and see if you get any errors:

Option Explicit
Sub mergemainbody()
Dim selRange As Range
Dim lRow    As Long
Dim ar As Range, col As Range

Set selRange = Selection
lRow = selRange.Rows.Count - 2    ' Why -2?
'On Error Resume Next
Application.DisplayAlerts = False

For Each col In selRange.Columns
    For Each ar In Cells(3, col.Column).Resize(lRow).SpecialCells(xlCellTypeBlanks).Areas
        ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge
    Next
Next col
End Sub

The only error that it may throw, is an error after there are no more SpecialCells(xlCellTypeBLanks), which means it ran successfully over all cells.

edited Sep 06 '16 at 15:27

answered Sep 06 '16 at 15:18

BruceWayne

22,923
15
65
110

That does make it work without errors, thanks! The problem is that I don't want it to work on the whole sheet, I want it to only work on selected cells (so my coworkers can use it as more data is added to the sheet). Is there a way of making it do that? – Elin B Sep 06 '16 at 15:21
@ElinBarrett - See the edit. It should loop through all columns in the *selected* range. – BruceWayne Sep 06 '16 at 15:27

score -2 · Answer 4 · answered Sep 06 '16 at 14:56

-2

take out the "On Error Resume Next" that's a sure fire way to hide any errors..

answered Sep 06 '16 at 14:56

Joe Bourne

1,144
10
18

1

Thanks for the tip! When I do that, I just get a '400' error box – Elin B Sep 06 '16 at 14:58
1

This will show the errors, but isn't likely to be the answer to the problem. This is better for a comment. – BruceWayne Sep 06 '16 at 14:59
@BruceWayne - it has unmasked the error, so its certainly one answer as to why its not working - there is an error occurring that's being swallowed. – Joe Bourne Sep 06 '16 at 15:04

Excel Visual Basic Macro to merge cells in a selected area

4 Answers4