Insert a row with specific contents after every merged data cell.....

[wolfwood]

Hi all

I've looked online for VBA code to insert a row with specific contents (ex. 'Example1' after every merged data cell (it should check for data) in a specified range (B13:B269), but none seem to work properly with the merged cells. Column B has merged cells, but column D does not (Column C is blank, and non-merged).

So, it looks something like this:

Column B Column D
MergedCell1 Data1a
MergedCell1 Data1b
MergedCell2 Data2a
MergedCell2 Data2b
MergedCell3 Data3a
MergedCell3 Data3b

And after the code, I'd like it to look like this:

Column B Column D
MergedCell1 Data1a
MergedCell1 Data1b
Example1
MergedCell2 Data2a
MergedCell2 Data2b
Example2
MergedCell3 Data3a
MergedCell3 Data3b
Example3

If possible, I'd like this to apply to the whole workbook as every sheet is identical in terms of the number of rows.

Many thanks!

~J

 

[skorpionkz]

Hi, this method is not very efficient and fast, but I am not sure if there is any other way to check how many cells are merged

Sub test()

Dim lrow As Long
Dim iCount As Integer, iSelection As Integer

lrow = 1
iCount = Empty
Do Until Cells(lrow, 2) = Empty
    Cells(lrow, 2).Select
    If Selection.Count > 1 Then
    iSelection = Selection.Count
    iCount = iCount + 1
        With Cells(lrow + iSelection, 2)
            .EntireRow.Insert
            .Offset(-1, 0).Value = "Example" & iCount
        End With
    lrow = lrow + iSelection
    End If
lrow = lrow + 1
Loop

End Sub

 

[MickG]

Try this:-
Lightly tested

[COLOR="Navy"]Sub[/COLOR] MG03Jun52
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n
[COLOR="Navy"]Dim[/COLOR] Ws [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ws [COLOR="Navy"]In[/COLOR] Worksheets
Lst = Ws.Range("B" & Rows.Count).End(xlUp).Row
    [COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
        [COLOR="Navy"]With[/COLOR] Ws.Range("B" & n)
            [COLOR="Navy"]If[/COLOR] .MergeCells = True [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                .MergeArea(1).EntireRow.Insert
                .MergeArea(1).Offset(-1).Value = "example" & c
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Ws
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[wolfwood]

Skorpionkz, I'm not sure if I'm entering it in the wrong place, but when I execute it there's no visible change to the data.

MickG, that works more or less perfectly. I removed the '& c' because I erroneously asked for each instance of 'example' to be +1. My mistake. EDIT Though there are cells within the B column which contain nothing but a colour and are still returning as having data in, and thus result in a row insertion. Can this be skipped?

Cheers both for the quick replies.

 

[MickG]

Perhaps this:-

[COLOR="Navy"]Sub[/COLOR] MG03Jun50
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n
[COLOR="Navy"]Dim[/COLOR] Ws [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ws [COLOR="Navy"]In[/COLOR] Worksheets
Lst = Ws.Range("B" & Rows.Count).End(xlUp).Row
    [COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
        [COLOR="Navy"]With[/COLOR] Ws.Range("B" & n)
            [COLOR="Navy"]If[/COLOR] .MergeCells = True And .Value <> "" [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                .MergeArea(1).EntireRow.Insert
                .MergeArea(1).Offset(-1).Value = "example" & c
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Ws
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[wolfwood]

Mick, the code still classes a blank cell with colour as a data cell. So after an empty cell filled with colour, I'm getting a row inserted with 'examplexx'. Any ideas?

Cheers

~J

 

[MickG]

Not sure how the colour has any effect !!!!
Please show layout of your data (that gives a problem) showing Merged and non Merged cells and, also the expected result.

 

[wolfwood]

Below is what happens. It inserts a row for each data cell except the one which precedes an empty (blue filled) cell. After which, it inserts a row. Grapes (Merged)
Examplex
Banana (Merged)
Examplex
Apple (Merged)
Examplex
Kiwi (Merged)
BLANK (Coloured Blue) (Not Merged)
Examplex
Orange (Merged)
Examplex
I'd hope it could simply go:
Kiwi (Merged) Examplex BLANK (Coloured Blue) (Not Merged) Orange (Merged) Examplex

<TBODY>
</TBODY>

 

[wolfwood]

I think I may see what is happening -- though I've no real grasp of code, so it's a hunch. The above happens even if the blue cell is without a fill colour. I also noticed the first entry has 'examplex' above it, and the last entry has no 'examplex' after it. So I assume the code is inserting the row above the merged data cell rather than below the merged data cell.

By having it insert the row below each cell, it'd resolve what I can see.

 

[wolfwood]

EDIT. Sorry for the multiposts (10min editing time). I changed the -1 on the offset to 1, and it seemed to work. Only, it inserts the 'examplex' with the blue colour format. (MergeArea(1).Offset(1).Value = "example" & c). It almost works, just need it to insert without the blue colour format.