Merge Cells in Column of Interior color 2

[mattloflin]

Short and Sweet.

Excel spread sheet. Columns N, O, and P

These are blank after the macro is run they have titles "Term" "Builder" "Done"
However after that the data get's sorted and it's based off types

ex:
type 1
type 1
type 1
<spacer> - (Interior color = Tan (19 index color))
type 2

I need to make code that will merge the cells of Column N all the type 1s, skip the spacer then merge all the type 2s. I need this for all three of those columns to but dont need them to merge together.

The last row is "newlastrow"

Any Ideas?

I have attached the Macro it's at the bottom of the first sub where it makes the seperation.

 

[ck1999]

This will work if i am understand you corretly

    Dim counter, counter2
    Dim vcol
        For vcol = 14 To 16
            For counter = 2 To newlastrow
                counter2 = counter
                Do While Cells(counter, vcol) = Cells(counter2, vcol) And counter2 <= newlastrow
                    counter2 = counter2 + 1
                Loop
                If counter2 <> counter Then
                    If Cells(counter, vcol) <> "" Then
                        Range(Cells(counter + 1, vcol), Cells(counter2 - 1, vcol)).Clear
                        Range(Cells(counter, vcol), Cells(counter2 - 1, vcol)).Merge
                    End If
                End If
                counter = counter2 - 1
            Next counter
        Next vcol

ck1999

 

[ck1999]

I reread you initial post if the 3 col are blank then use
and your type is based off col a

    Dim counter, counter2

            For counter = 2 To newlastrow
                counter2 = counter
                Do While Cells(counter, "A") = Cells(counter2, "A") And counter2 <= newlastrow
                    counter2 = counter2 + 1
                Loop
                If counter2 <> counter Then
                    If Cells(counter, "A") <> "" Then
                        Range(Cells(counter + 1, "n"), Cells(counter2 - 1, "n")).merge
                        Range(Cells(counter, "o"), Cells(counter2 - 1, "o")).Merge
                        Range(Cells(counter, "p"), Cells(counter2 - 1, "p")).Merge
                    End If
                End If
                counter = counter2 - 1
            Next counter

ck1999

 

[mintjulep]

Never merge cells. Nothing good can come of it.

 

[xlbo]

second that

better option is to use "Centre across selection" in the cell alignment options

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[mattloflin]

i'm not basing the information off of anything I'm just wanting it to merge the cells inbetween the spacers that have the color index. so it will be

MERGED MERGED
<spacer> <spacer>
MERGED Merged
<space> <Spacer>

in all the columns.

They are not based off of each other just based off of the fact of the color of the spacer. They are all independent columns not relating to each other.

 

[ck1999]

From the code prior to where you want to insert this code Does it not go through column A and add a spacer where column A changes Value. (By inserting a line and then coloring this line?

So my second should merge and do what you are asking.

At least try it and see if it is what you want.

ck1999

 

[mattloflin]

it works perfect on O and P but butchers it on N... seems like it's one off somewhere or something everything seems to be pushed down one

 

[ck1999]

Change N statement to
Range(Cells(counter, "n"), Cells(counter2 - 1, "n")).merge

The three statements should be exact except for the column name

Sorry for the added "+1"

ck1999

 

[mattloflin]

got... that's awesome. Thanks if I could give you Kudo's I would!

 

[SkipVought]

mattloflin,

"...if I could give you Kudo's I would!"

Here at Tek-Tips, thanks for valuable posts can be recognized by the little purple stars. You can offer that expression by clicking the LINK in the lower left-hand corner of any post worth of thanks.

Skip,

_{Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty!}

 

[mattloflin]

uh oh... expanding on this Merge thing. This is the code that creates the seperator between the different columns.

    aItem = Sheets("Build Sheet").Range("A1")
    For i = 2 To newlastrow
        bItem = Sheets("Build Sheet").Range("A" & i)
        If (aItem <> bItem) Then
            Rows(i & ":" & i).Select
            Selection.Insert Shift:=xlDown
            Range("A" & i & ":P" & i).Select
            With Selection.Interior
                .ColorIndex = 19
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
            aItem = bItem
        End If
    Next i

what this does is sees if the "Label" equals the "Label" right under it and if it doesn't then it creates a seperator.

However I need this based off two columns. For instance. I need it to do what it's currently doing. Alls do a divider if the part numbers don't match.

ex:
(currently doing)
part number1
part number2
<divider>
part2 number1
part2 number2

(want to do)
part number1
<divider>
part number2
etc...

I can't have it just sort by part number because there are some "part" ex. part1 & part2 that have the same numbers.

ex.
part1 number1
part2 number1

. How could I combine the code to make a seperator if any of this conditions are met without it making two spacers?

Thanks Guys

also this code makes multiple divider lines:

    aItem = Sheets("Build Sheet").Range("A1")
    For i = 2 To newlastrow
        bItem = Sheets("Build Sheet").Range("A" & i)
        If (aItem <> bItem) Then
            Rows(i & ":" & i).Select
            Selection.Insert Shift:=xlDown
            Range("A" & i & ":P" & i).Select
            With Selection.Interior
                .ColorIndex = 19
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
            aItem = bItem
        End If
    Next i
cItem = Sheets("Build Sheet").Range("B1")
    For i = 2 To newlastrow
        dItem = Sheets("Build Sheet").Range("B" & i)
        If (dItem <> cItem) Then
            Rows(i & ":" & i).Select
            Selection.Insert Shift:=xlDown
            Range("B" & i & ":P" & i).Select
            With Selection.Interior
                .ColorIndex = 19
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
            cItem = dItem
        End If
    Next i

 

[ck1999]

    aitem = Sheets("Build Sheet").Range("A1") & " " & Sheets("Build Sheet").Range("b1")
    For i = 2 To newlastrow
        bItem = Sheets("Build Sheet").Range("A" & i) & " " & Sheets("Build Sheet").Range("b" & i)
        If (aitem <> bItem) Then
            Rows(i & ":" & i).Select
            Selection.Insert Shift:=xlDown
            Range("A" & i & ":P" & i).Select
            With Selection.Interior
                .ColorIndex = 19
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
            aitem = bItem
        End If
    Next i

 

[mattloflin]

Thanks again. You know I never even thought about that. I feel kind of ignorant now.

Thanks ck1999

 

[AnotherHiggins]

I'd like to offer a few thoughts, Matt.

First, I'd like to echo those above who advise against merged cells. They are a terrible thing. Even if you don't mind them, you might drive other users crazy.

Also, when inserting rows, it is usually easier to start from the end and work up. So replace the commented out line with the new one:

[green]
'    For i = 2 To newlastrow[/green]
    [b]For = i newlastrow to 2 Step -1[/b]

Once again, avoid selecting whenever you can. You don't have to use .Select or .Activate even once for this task.

As for checking both columns A & B, just use an OR.

Try this:

    For i = newlastrow To 2 Step -1
        If _
            Range("A" & i) <> Range("A" & i - 1) Or _
            Range("B" & i) <> Range("B" & i - 1) Then
                Range(i & ":" & i).Insert
                Range("A" & i & ":P" & i).Interior.ColorIndex = 19
        End If
    Next i

I've also dropped the "Shift:=xlDown" after Selection.Insert. Since you are inserting an entire row, you don't need to specify "down" - because there is nowhere else to shift.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[mattloflin]

That works great! I have cut a few seconds off.

I still think it could be alot faster if I somehow shortened this code:

    Sheets("Build Sheet").Range("A2:A" & newlastrow).Value = Sheets("PreProcess Doc").Range("B2:B" & newlastrow).Value
    Sheets("Build Sheet").Range("B2:B" & newlastrow).Value = Sheets("PreProcess Doc").Range("R2:R" & newlastrow).Value
    Sheets("Build Sheet").Range("C2:C" & newlastrow).Value = Sheets("PreProcess Doc").Range("W2:W" & newlastrow).Value
    Sheets("Build Sheet").Range("D2:D" & newlastrow).Value = Sheets("PreProcess Doc").Range("T2:T" & newlastrow).Value
    Sheets("Build Sheet").Range("E2:E" & newlastrow).Value = Sheets("PreProcess Doc").Range("U2:U" & newlastrow).Value
    Sheets("Build Sheet").Range("F2:F" & newlastrow).Value = Sheets("PreProcess Doc").Range("V2:V" & newlastrow).Value
    Sheets("Build Sheet").Range("G2:G" & newlastrow).Value = Sheets("PreProcess Doc").Range("D2:D" & newlastrow).Value
    Sheets("Build Sheet").Range("H2:H" & newlastrow).Value = Sheets("PreProcess Doc").Range("M2:M" & newlastrow).Value
    Sheets("Build Sheet").Range("I2:I" & newlastrow).Value = Sheets("PreProcess Doc").Range("J2:J" & newlastrow).Value
    Sheets("Build Sheet").Range("J2:J" & newlastrow).Value = Sheets("PreProcess Doc").Range("N2:N" & newlastrow).Value
    Sheets("Build Sheet").Range("K2:K" & newlastrow).Value = Sheets("PreProcess Doc").Range("K2:K" & newlastrow).Value
    Sheets("Build Sheet").Range("L2:L" & newlastrow).Value = Sheets("PreProcess Doc").Range("P2:P" & newlastrow).Value
    Sheets("Build Sheet").Range("M2:M" & newlastrow).Value = Sheets("PreProcess Doc").Range("G2:G" & newlastrow).Value

I tried what someone else put but it gave errors.

Any Ideas? This is my last question I promise.

 

[AnotherHiggins]

We can't read your mind.

What error? On what line?

If nothing else, replace
Sheets("Build Sheet").Range("A2:A" & newlastrow).Value = Sheets("PreProcess Doc").Range("B2:B" & newlastrow).Value
with

Sheets("Build Sheet").Range("A:A") = Sheets("PreProcess Doc").Range("B:B")

And isn't this the problem we worked on in a different thread? If so, it would be helpful if you posted in that same thread so others can see what has already been suggested.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[mattloflin]

done! thanks for the help higgins

 

[SkipVought]

Hey MATT,

Still waiting to SEE you...
[blue]
Thank WHOEVER
for this valuable post!
[/blue]
after posting for the past 2 weeks nine times.

Skip,

_{Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty!}

 

[SkipVought]

Matt,

I see that you finally caught on. Good for you!

Happy Tek-Tippin.

Skip,

_{Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty!}