Go down a list and insert two rows

[RyanScharfy]

I might be exposing myself a bit here, but here it goes. Many thanks in advance. This request might seem a little strange, but there is a method to my madness.

I have a list.. I'd like a macro to scan down the 1st column (Color) and add two rows after every change in color
So this:

Color Name
Red Frank
Red Frank
Red Tom
Red Tom
Green Frank
Green Frank
Green Tom
Green Tom
Green Rick
Green Rick
Blue Frank
Blue Frank

Would look like this:

So this:

Color Name
Red Frank
Red Frank
Red Tom
Red Tom


Green Frank
Green Frank
Green Tom
Green Tom
Green Rick
Green Rick


Blue Frank
Blue Frank

 

[SkipVought]

Hi,

Take it from experience. When you CHOP UP DATA by inserting rows or columns, you shoot yourself in the foot.

You can achieve the same effect by changing the row height to emphasize the change in the values.

I am also an advocate of making as much of an applications parameters, data driven, rather than having to change the program wehn you want some characteristic to look or be diffrerent.

So, for instance, you could make a spreadseet formula, that you detect the change in your color column values, and return a value for the row height. Change the parameters; run the procedure; see how it looks.

I usually have a sheet for my parameters, named Factors. On that sheet, name two individual cells, NormRow, ChangeRow.

On the data sheet, in the next adjacent column, looks like column C to me...
[tt]
C2: =if(a2=a1,NormRow,ChangeRow)
[/tt]
and copy down.

Then loop thru the valued in that column

sub ChangeRowHeight()
dim r as range
for each r in range([C2], [C2].end(xldown))
  with r
    .entirerow.rowheight = .value  
  end with
next
end sub

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[RyanScharfy]

Well... here's my problem.... my real spreadsheet contains a couple more columns and a total. Here's the redo.

Client Location Year Hours Jan Feb March etc.
Barneys California 2009 10
Barneys California 2010 9
Barneys New York 2009 8
Barneys New York 2010 7
Barneys 2009 Total 18
Barneys 2010 Total 16
BarfBurg California 2009 10
BarfBurg California 2010 9
BarfBurg New York 2009 8
BarfBurg New York 2010 7
BarfBurg Florida 2009 8
BarfBurg Florida 2010 7
BarfBurg 2009 Total 24
Barfburg 2008 Total 23

I need to send the worksheet to somebody to fill in revised hours. It would be nice to have a "double" subtotal on each client by Client/Year, ignoring the location. (In fact, the hours are by month, but for economy I've simplified it to the toal hours for each year below). I have another worksheet that contains all the formulas I need and I can write the macro to paste them over and in.

It's even more complex than this, but I'm trying to just explain why I asked the first question.

 

[SkipVought]

Do you have the source data for this REPORT. Know that it is much MUCH MUCH more difficult to work with a REPORT than with a proper TABLE.

Here's an example of a PROPER TABLE...
[tt]
Agt Dte amt
dave 1/1/2009 2
sam 1/1/2010 3
sam 2/1/2009 4
dave 2/1/2010 5
[/tt]
Here's a REPORT using the PivotTable Wizard (no VBA and took about 30 seconds)
[tt]
Sum of amt Dte
Agt Years Jan Feb Grand Total
dave 2009 2 2
2010 5 5
dave Total 2 5 7
sam 2009 4 4
2010 3 3
sam Total 3 4 7
Grand Total 5 9 14
[/tt]

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[RyanScharfy]

Sorry, that wasn't what I needed. I see exactly where you're going with it, and understand, but there are just some issues on my end that I can't shortcut. That being said, I did some research, and a version of this worked. I appreciate the try though Skip. You've solved a bunch of issues for me over the years.

Sub Test2()
' Select cell A2, *first line of data*.
Range("A2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
' Insert your code here.
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
End Sub

 

[SkipVought]

Wunderful!

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]