Consulting

Results 1 to 10 of 10

Thread: dynamically merging cells in different rows based on the position on the worksheet

  1. #1

    Question dynamically merging cells in different rows based on the position on the worksheet

    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.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    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 mergedAttachment 1514

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    here is the after example Attachment 1515

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    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
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    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.

  8. #8
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    No it doesn't delete them, it hides them. I don't agree with merged cells, they are bad!
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  9. #9
    ok.. but i need the cells to be merged for the presentation purposes. please?

  10. #10
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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

    [vba]

    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
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •