PDA

View Full Version : dynamically merging cells in different rows based on the position on the worksheet



yfbuenaseda
08-03-2009, 02:42 PM
I have a worksheet that sorts out different jobs and completion dates that I am attempting to automate. The last thing I need is to have certain parts of the worksheet merge together. So basically in the sheet there are grey rows that represent the main job and underneath there are white rows that describe certain tasks. I need code that will go through the worksheet and for a specific column, take the white parts in between two gray rows and merge them together because the information is the same. I need it to be dynamic because sometimes there are no tasks in between two greys ( grey = 15) and sometimes there are 5. Can anyone help me out.
ex/
PSM 252 Data Management 3 01-Apr-05
PSM 252 Data Management 3 01-Apr-05
PSM 252 Data Management 3 01-Apr-05
MFTS 177 Research 3 01-Apr-05
PSM 389 Data Management 1 13-Apr-05

so the two record numbers that say 252 in black under the original in grey would be merged.

Bob Phillips
08-03-2009, 02:51 PM
What do you mean by merged? DO you mean remove the surplus? If you mean merge the two cells as in Excel merge, I have to ask why?

And is the grey and black a tru reprsentation of the data, or just to show wat to do?

yfbuenaseda
08-03-2009, 03:02 PM
I mean merge becasue I am pulling a database that automatically fills every cell. For presentation purposes I don't want the excel sheet to be repetetive. the black and grey just show what to do the data looks like the attatched sheet. i want the first 3 columns to have the white parts with similar data merged row wise not column wise. So all the YO with a white background would be merged. and all the Notes. and all the numbers 712. then the next grey would be skipped and the GYT with a white background would be merged1514

Bob Phillips
08-03-2009, 03:23 PM
I am sorry, but I am confused. Are there grey and white or not? You said no, then started talking about the grey and white. As I see it, rows 1 to 18 have the same date in columns A, B, C. Do you wan t those emerged, jsut columns A, B, C?

Why not give a before and after example covering all possibilties, with the data as it really looks.

yfbuenaseda
08-03-2009, 03:32 PM
here is the after example 1515

Bob Phillips
08-04-2009, 01:14 AM
Public Sub FormatData()
Dim LastRow As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow

If .Cells(i, "A").Value = .Cells(i + 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i + 1, "B").Value And _
.Cells(i, "C").Value = .Cells(i + 1, "C").Value And _
.Cells(i, "D").Value = .Cells(i + 1, "D").Value And _
.Cells(i, "E").Value = .Cells(i + 1, "E").Value And _
.Cells(i, "F").Value = .Cells(i + 1, "F").Value And _
.Cells(i, "G").Value = .Cells(i + 1, "G").Value And _
.Cells(i, "H").Value = .Cells(i + 1, "H").Value Then

.Cells(i, "A").Resize(, 8).Font.ColorIndex = 2
End If
Next i
End With
End Sub

yfbuenaseda
08-04-2009, 07:08 AM
Thank You! but the code you gave me deletes the cells that are repeated, but what i need is for the repeated cells to be merged.

Bob Phillips
08-04-2009, 07:59 AM
No it doesn't delete them, it hides them. I don't agree with merged cells, they are bad!

yfbuenaseda
08-04-2009, 08:02 AM
ok.. but i need the cells to be merged for the presentation purposes. please?

Bob Phillips
08-04-2009, 08:20 AM
Okay, I will do it for you, but I think you are wrong and you should get out of the habit of merged cells as fast as you can



Option Explicit

Public Sub FormatData()
Dim LastRow As Long
Dim StartRow As Long
Dim i As Long, j As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
StartRow = 2
For i = 3 To LastRow

If .Cells(i, "A").Value = .Cells(i + 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i + 1, "B").Value And _
.Cells(i, "C").Value = .Cells(i + 1, "C").Value And _
.Cells(i, "D").Value = .Cells(i + 1, "D").Value And _
.Cells(i, "E").Value = .Cells(i + 1, "E").Value And _
.Cells(i, "F").Value = .Cells(i + 1, "F").Value And _
.Cells(i, "G").Value = .Cells(i + 1, "G").Value And _
.Cells(i, "H").Value = .Cells(i + 1, "H").Value Then

Else

For j = 1 To 8

.Cells(StartRow, j).Resize(i - StartRow + 1).MergeCells = True
Next j

StartRow = i + 2
End If
Next i
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub