Hi,

A colleague has a spreadsheet with a list of 400 salon names in Column
A. She wants to add a list of sub headings, also in Column A, beneath
each salon name. There are 16 items on the list and one blank cell
before the next salon name. I have written a Macro to copy the initial
cells from below the first salon name (A2:A18) and insert them below
the second salon name.

Range("A2:A18").Select
Selection.Copy
Range("A20").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=-3

How do I now get this to insert it after each salon name?

I hope someone can help!

Many thanks,

Richard Thorneycroft

After much trial and error doing a little more research I've come up
with this, for a test of just 8 salon names...

Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
StartRow = 1 '<<< CHANGE to appropriate row number
EndRow = 8 '<<< CHANGE to appropriate row number
Arr = Application.Transpose(Array("Hair Service", "Hair Retail", "Total
Hair", "Beauty Service", "Beauty Retail", "Total Beauty", "Total",
"Colour Number", "Treatment Number", "Facial Number", "Waxing Number",
"Hair Service Customer No", "Beauty Service Customer No", "Hair CF
Count", "Beauty CF Count", ""))
For RowNdx = StartRow + 1 To (EndRow) * 16 Step 17
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdx

Could some one let me know if this is correct, it seems to work fine on
a test of 8 salon names, but I'm not sure if it's the best way of
getting the job done.

Cheers,

Rich

Hi Rich,
Don't ask me why but I had to change EndRow = 8 to EndRow = 425 for all
400 salons to be done. Trial and error got me there. Loops are always
hard to follow.
To speed things up a bit I threw in "Application.ScreenUpdating =
False" at the start to prevent all the screen flashing. It can be put
anywhere in the code so long as it's before the Loop.
Ken Johnson

You can determine a variable end row by

endrow=cells(rows.count,"a").end(xlup).row

change the "a" to the column desired.

--
Don Guillett
SalesAid Software

"Ken Johnson" wrote in message
oups.com...
Hi Rich,
Don't ask me why but I had to change EndRow = 8 to EndRow = 425 for all
400 salons to be done. Trial and error got me there. Loops are always
hard to follow.
To speed things up a bit I threw in "Application.ScreenUpdating =
False" at the start to prevent all the screen flashing. It can be put
anywhere in the code so long as it's before the Loop.
Ken Johnson

Thanks for that Don.

However I can't seem to get the
endrow=cells(rows.count,"a").end(xlup).row line to fundtion correctly.

My code looks like this and it leaves 23 salons not done.


Sub InsertValuesBelowCells()


'
' Macro3 Macro
' Macro recorded 16/01/2006 by Rich T
'
Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
StartRow = 1
EndRow = Cells(Rows.Count, "A").End(xlUp).Row
Arr = Application.Transpose(Array("Hair Service", "Hair Retail", "Total
Hair", "Beauty Service", "Beauty Retail", "Total Beauty", "Total",
"Colour Number", "Treatment Number", "Facial Number", "Waxing Number",
"Hair Service Customer No", "Beauty Service Customer No", "Hair CF
Count", "Beauty CF Count", ""))
For RowNdx = StartRow + 1 To (EndRow) * 16 Step 17
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdx


'
End Sub

Hi Ken,

Thanks for the screen updating tip. However, I can't get it to run to
the right place, it seems however I try it it always leaves 23 salons
unfinished.

I tried Don's suggestion below and your 425. I also tried other
numbers, but still 23 lines were left untouched!?

Any ideas where I am going wrong?

Thanks again.

Rich

Hi Guys,

Hust a little more info.

The macro below works fine until the number of rows increases. I've
tried it with up to 15 rows and it works fine, anything over that and
it doesn't finish the range. It seems the more rows, the more it leaves
untouched, but I can't see a pattern. With 16 rows it leaves 1 not done
and the same with 30 rows. With 50 rows it leaves 3, but with 400 rows
it leaves 23 not done?!?

Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
StartRow = 1
EndRow = Cells(Rows.Count, "A").End(xlUp).Row
Arr = Application.Transpose(Array("Hair Service", "Hair Retail", "Total

Hair", "Beauty Service", "Beauty Retail", "Total Beauty", "Total",
"Colour Number", "Treatment Number", "Facial Number", "Waxing Number",
"Hair Service Customer No", "Beauty Service Customer No", "Hair CF
Count", "Beauty CF Count", ""))
For RowNdx = StartRow + 1 To (EndRow) * 16 Step 17
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdx

Life will be lots easier if you start at the bottom and work up the range.

Same thing when you're deleting rows, too:

Option Explicit
Sub testme()
Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
StartRow = 1
EndRow = Cells(Rows.Count, "A").End(xlUp).Row
Arr = Application.Transpose(Array("Hair Service", "Hair Retail", _
"Total Hair", "Beauty Service", "Beauty Retail", _
"Total Beauty", "Total", "Colour Number", "Treatment Number", _
"Facial Number", "Waxing Number", "Hair Service Customer No", _
"Beauty Service Customer No", "Hair CF Count", "Beauty CF Count", ""))
For RowNdx = EndRow To StartRow + 1 Step -1
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdx
Application.ScreenUpdating = True
End Sub



wrote:

Hi Guys,

Hust a little more info.

The macro below works fine until the number of rows increases. I've
tried it with up to 15 rows and it works fine, anything over that and
it doesn't finish the range. It seems the more rows, the more it leaves
untouched, but I can't see a pattern. With 16 rows it leaves 1 not done
and the same with 30 rows. With 50 rows it leaves 3, but with 400 rows
it leaves 23 not done?!?

Dim RowNdx As Long
Dim Arr As Variant
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
StartRow = 1
EndRow = Cells(Rows.Count, "A").End(xlUp).Row
Arr = Application.Transpose(Array("Hair Service", "Hair Retail", "Total

Hair", "Beauty Service", "Beauty Retail", "Total Beauty", "Total",
"Colour Number", "Treatment Number", "Facial Number", "Waxing Number",
"Hair Service Customer No", "Beauty Service Customer No", "Hair CF
Count", "Beauty CF Count", ""))
For RowNdx = StartRow + 1 To (EndRow) * 16 Step 17
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdx

--

Dave Peterson

Hi Rich,
I can confirm the 23 undone salons using EndRow =
Cells(Rows.Count,"A".End(xlUp).Row,
however, I get all 400 salons done using EndRow = 425.
Beats me what's going wrong at your end. I pasted the code from your
last reply and just changed the EndRow.
Ken Johnson