How to renumber with merged cells?

[Tussas]

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

 

[Rick Rothstein]

Something like this should work (set the LastRow value by whatever means you are now using to calculate it)...

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]

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]

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]

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]

Tussas,

Unfortunately I was looking at your duplicate thread!!

Here is a possibility...


Minor mod to Rick's 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

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]

Tussas,

Unfortunately I was looking at your duplicate thread!!

Here is a possibility...


Minor mod to Rick's 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

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.

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]

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]

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