# How to renumber with merged cells?

#### Tussas

##### New Member
Hi all,

I have a database, where in column "B" of one of the worksheets some cells are merged (by
2, 3 or more) and some are not.
I want to number them in order that
every single or "group-of-merged-cells" cell will have just one number.

For example, 3rd + 4th are merged, 5th is single and 5th+6th+7th are merged. This way about 10000 rows in first column.
How to number them in order?

I already have a partial solution:

Sub numberCells()
Dim i As Long, j As Long
i = 1
j = 1
Do
If Cells(i, "B").MergeArea.Rows.Count > 1 Then
Cells(i, "B").Value = j
i = i + Cells(i, "B").MergeArea.Rows.Count
Else
Cells(i, "B").Value = j
i = i + 1
End If
j = j + 1
Loop Until j > 1000
End Sub
My problems:

1. Renumbering can only start in row 3. The first two rows are not numbered.
2. This is to be done only in one of the tabs called "Global List". This one will map the others through another macro.

How can I adapt the code to it?

Thanks,
Tiago

### Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

#### Rick Rothstein

##### MrExcel MVP
Something like this should work (set the LastRow value by whatever means you are now using to calculate it)...
Code:
``````Sub NumberWithMergedCells()
Dim R As Long, X As Long, LastRow As Long
LastRow = 1000
R = 3
Do
X = X + 1
Sheets("Global List").Cells(R, "B").Value = X
R = R + Sheets("Global List").Cells(R, "B").MergeArea.Count
Loop While R <= LastRow
End Sub``````

#### Tussas

##### New Member
awesomely done Rick!

It works just fine, thanks I'm thinking on adding this automatically when I have a new row inserted.
I can't find anything like Insert row and I've read it is not possible.

Is this correct? I can't do this automatically when I insert a row?

Thanks,
Tiago

#### Rick Rothstein

##### MrExcel MVP
I'm thinking on adding this automatically when I have a new row inserted.
I can't find anything like Insert row and I've read it is not possible.

Is this correct? I can't do this automatically when I insert a row? How are you adding the row such that only Column B contains merged cells? I guess my question is at what point do the cells in Column B become merged such that you have to then number them?

#### Tussas

##### New Member
My sheet as up-to-date 143 rows. I already have merged cells in them and all of them numbered in column B.

If I add a row between two single cells I will have have to update the numbering again.
If I add a row between row 5 and 6 which are merged I will have a merged cell of 3 and nothing has to be done in the numbering.

Worst case scenario: If I add a row between two single cells and then want to merge it to one of them then I will have to renumber it manually or wait for the next added row.

As I wrote you back, I understood that with the latest, I think having the button with your code is the best for this case. It guarantees all possibilities But for curiosity, how could I do something like it?

Thanks once again!
Tussas

#### Snakehips

##### Well-known Member
Tussas,

Here is a possibility...

Minor mod to Rick's code.
Rich (BB code):
``````Sub NumberWithMergedCells()
Application.EnableEvents = False
Dim R As Long, X As Long, LastRow As Long
LastRow = 1000
R = 3
Do
X = X + 1
Sheets("Global List").Cells(R, "B").Value = X
R = R + Sheets("Global List").Cells(R, "B").MergeArea.Count
Loop While R <= LastRow
Application.EnableEvents = True
End Sub``````
Sheet Change Event code

Rich (BB code):
``````Private Sub Worksheet_Change(ByVal Target As Range)
Static lngRow As Long
Dim rng1 As Range
Set rng1 = ThisWorkbook.Names("RowMarker").RefersToRange
If lngRow = 0 Then
lngRow = rng1.Row
Exit Sub
End If
If rng1.Row = lngRow Then Exit Sub
If rng1.Row > lngRow Then
' row inserted so .....
Call NumberWithMergedCells

End If
lngRow = rng1.Row
End Sub``````

Hope that helps.

#### Kurt

##### Well-known Member
Tussas,

Here is a possibility...

Minor mod to Rick's code.
Rich (BB code):
``````Sub NumberWithMergedCells()
Application.EnableEvents = False
Dim R As Long, X As Long, LastRow As Long
LastRow = 1000
R = 3
Do
X = X + 1
Sheets("Global List").Cells(R, "B").Value = X
R = R + Sheets("Global List").Cells(R, "B").MergeArea.Count
Loop While R <= LastRow
Application.EnableEvents = True
End Sub``````
Sheet Change Event code

Rich (BB code):
``````Private Sub Worksheet_Change(ByVal Target As Range)
Static lngRow As Long
Dim rng1 As Range
Set rng1 = ThisWorkbook.Names("RowMarker").RefersToRange
If lngRow = 0 Then
lngRow = rng1.Row
Exit Sub
End If
If rng1.Row = lngRow Then Exit Sub
If rng1.Row > lngRow Then
' row inserted so .....
Call NumberWithMergedCells

End If
lngRow = rng1.Row
End Sub``````

Hope that helps.
This is some code that Smitty helped me with that will completely get rid of your merged cells and solve your numbering problem.

Rich (BB code):
``````Sub FindMerged2()
'http://www.extendoffice.com/documents/excel/962-excel-select-merged-cells.html
Dim c As Range
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
c.Interior.ColorIndex = 36
End If
Next
End Sub
Sub FindMerged4()
Dim c As Range
Dim sMsg As String
sMsg = ""
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
If sMsg = "" Then
sMsg = "Merged worksheet cells:" & vbCr
End If
sMsg = sMsg & Replace(c.Address, "\$", "") & vbCr
End If
Next
If sMsg = "" Then
sMsg = "No merged worksheet cells."
End If
MsgBox sMsg
End Sub``````
From this link posted earlier today:

http://www.mrexcel.com/forum/excel-...ions-code-delete-unmerge-cells-keep-data.html

HTH it worked wonderfully for me. Kurt

#### Snakehips

##### Well-known Member
Tussas,

Just lying in bed and realised that I missed an important part of my post #6 solution!!!!
Must post or it will keep me awake!!

You need to define a Named Range... as RowMarker ='Global List'!\$C\$2000
Edit the 2000 to some suitably high row number that is bigger than your data set.

Now back to bed!!

#### Tussas

##### New Member
Snakehips and Kurt, thank you for the help! It works just fine Another question.
In that same excel I have another macro.
Its goal is:
1. To copy 8 columns from 'Global List' to 'Front'. Global List has some merged cells and Front can't have it so as to be aligned with the rest of the info when I copy it.

I use this code:

Sub Front()
Dim LastRow As Long
LastRow = Range("B" & Rows.count).End(xlUp).Row
Worksheets("Front").Range("A1:D400").Value = Worksheets("Global List").Range("A1:D400").Value
Worksheets("Front").Range("E1:H400").Value = Worksheets("Global List").Range("G1:J400").Value

Dim CopyRng As Range, PasteFront As Range, CopyOffer As Range, PasteOffer As Range

Set CopyRng = Application.Selection
Set CopyRng = Worksheets("Global List").Range("A1:D400")
Set PasteFront = Worksheets("Front").Range("A1:D400")
CopyRng.Copy
PasteFront.Parent.Activate
PasteFront.PasteSpecial xlPasteFormats

Set CopyOffer = Application.Selection
Set CopyOffer = Worksheets("Global List").Range("G1:J400")
Set PasteOffer = Worksheets("Front").Range("E1:H400")
CopyOffer.Copy
PasteOffer.Parent.Activate
PasteOffer.PasteSpecial xlPasteFormats

Dim i As Integer
Dim count As Integer

For i = 3 To 200
If Worksheets("Front").Range("C" & i).Value = "" Then
count = count + 1
End If
Next i

While count <> 0

For i = 3 To 200
If Worksheets("Front").Range("C" & i).Value = "" Then
Worksheets("Front").Range("C" & i).UnMerge
Worksheets("Front").Range("C" & i).Delete Shift:=xlUp
Worksheets("Front").Range("A" & i).Delete Shift:=xlUp
Worksheets("Front").Range("B" & i).Delete Shift:=xlUp
Worksheets("Front").Range("D" & i).Delete Shift:=xlUp
Worksheets("Front").Range("E" & i).Delete Shift:=xlUp
Worksheets("Front").Range("F" & i).Delete Shift:=xlUp
Worksheets("Front").Range("G" & i).Delete Shift:=xlUp
Worksheets("Front").Range("H" & i).Delete Shift:=xlUp
End If
Next i
count = count - 1
Wend

Application.CutCopyMode = False

End Sub

Problem:
1. Column A is merged and my code maintains it merged but its info is deleted..
2. I used row 400 but what I want is to find LastRow and map until it.

New thing I'm trying to do:
I have another sheet where I want to copy that same information to. But this sheet also has merged cells and in a number not identical to Global List.
I've found the logic of what I need but I don't know how to adapt it to code..

Basically I need to copy the information from Global List (A, B, C, D) and I need to insert or delete rows when I copy it so this information has the same number of rows as the merged cells of column I.
This logic makes me think it's possible to do it with vba/macro.

Am I right?

Thanks,
Tiago