software

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(quot;A2:A18quot;).Select
Selection.Copy
Range(quot;A20quot;).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 ThorneycroftAfter 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 'lt;lt;lt; CHANGE to appropriate row number
EndRow = 8 'lt;lt;lt; CHANGE to appropriate row number
Arr = Application.Transpose(Array(quot;Hair Servicequot;, quot;Hair Retailquot;, quot;Total
Hairquot;, quot;Beauty Servicequot;, quot;Beauty Retailquot;, quot;Total Beautyquot;, quot;Totalquot;,
quot;Colour Numberquot;, quot;Treatment Numberquot;, quot;Facial Numberquot;, quot;Waxing Numberquot;,
quot;Hair Service Customer Noquot;, quot;Beauty Service Customer Noquot;, quot;Hair CF
Countquot;, quot;Beauty CF Countquot;, quot;quot;))
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,

RichHi 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 quot;Application.ScreenUpdating =
Falsequot; 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 JohnsonYou can determine a variable end row by

endrow=cells(rows.count,quot;aquot;).end(xlup).row

change the quot;aquot; to the column desired.

--
Don Guillett
SalesAid Software

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

However I can't seem to get the
endrow=cells(rows.count,quot;aquot;).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, quot;Aquot;).End(xlUp).Row
Arr = Application.Transpose(Array(quot;Hair Servicequot;, quot;Hair Retailquot;, quot;Total
Hairquot;, quot;Beauty Servicequot;, quot;Beauty Retailquot;, quot;Total Beautyquot;, quot;Totalquot;,
quot;Colour Numberquot;, quot;Treatment Numberquot;, quot;Facial Numberquot;, quot;Waxing Numberquot;,
quot;Hair Service Customer Noquot;, quot;Beauty Service Customer Noquot;, quot;Hair CF
Countquot;, quot;Beauty CF Countquot;, quot;quot;))
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 SubHi 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.

RichHi 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, quot;Aquot;).End(xlUp).Row
Arr = Application.Transpose(Array(quot;Hair Servicequot;, quot;Hair Retailquot;, quot;Total

Hairquot;, quot;Beauty Servicequot;, quot;Beauty Retailquot;, quot;Total Beautyquot;, quot;Totalquot;,
quot;Colour Numberquot;, quot;Treatment Numberquot;, quot;Facial Numberquot;, quot;Waxing Numberquot;,
quot;Hair Service Customer Noquot;, quot;Beauty Service Customer Noquot;, quot;Hair CF
Countquot;, quot;Beauty CF Countquot;, quot;quot;))
For RowNdx = StartRow 1 To (EndRow) * 16 Step 17
Rows(RowNdx).Resize(16).Insert
Cells(RowNdx, 1).Resize(16, 1).Value = Arr
Next RowNdxLife 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, quot;Aquot;).End(xlUp).Row
Arr = Application.Transpose(Array(quot;Hair Servicequot;, quot;Hair Retailquot;, _
quot;Total Hairquot;, quot;Beauty Servicequot;, quot;Beauty Retailquot;, _
quot;Total Beautyquot;, quot;Totalquot;, quot;Colour Numberquot;, quot;Treatment Numberquot;, _
quot;Facial Numberquot;, quot;Waxing Numberquot;, quot;Hair Service Customer Noquot;, _
quot;Beauty Service Customer Noquot;, quot;Hair CF Countquot;, quot;Beauty CF Countquot;, quot;quot;))
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 Subwrote:
gt;
gt; Hi Guys,
gt;
gt; Hust a little more info.
gt;
gt; The macro below works fine until the number of rows increases. I've
gt; tried it with up to 15 rows and it works fine, anything over that and
gt; it doesn't finish the range. It seems the more rows, the more it leaves
gt; untouched, but I can't see a pattern. With 16 rows it leaves 1 not done
gt; and the same with 30 rows. With 50 rows it leaves 3, but with 400 rows
gt; it leaves 23 not done?!?
gt;
gt; Dim RowNdx As Long
gt; Dim Arr As Variant
gt; Dim StartRow As Long
gt; Dim EndRow As Long
gt; Application.ScreenUpdating = False
gt; StartRow = 1
gt; EndRow = Cells(Rows.Count, quot;Aquot;).End(xlUp).Row
gt; Arr = Application.Transpose(Array(quot;Hair Servicequot;, quot;Hair Retailquot;, quot;Total
gt;
gt; Hairquot;, quot;Beauty Servicequot;, quot;Beauty Retailquot;, quot;Total Beautyquot;, quot;Totalquot;,
gt; quot;Colour Numberquot;, quot;Treatment Numberquot;, quot;Facial Numberquot;, quot;Waxing Numberquot;,
gt; quot;Hair Service Customer Noquot;, quot;Beauty Service Customer Noquot;, quot;Hair CF
gt; Countquot;, quot;Beauty CF Countquot;, quot;quot;))
gt; For RowNdx = StartRow 1 To (EndRow) * 16 Step 17
gt; Rows(RowNdx).Resize(16).Insert
gt; Cells(RowNdx, 1).Resize(16, 1).Value = Arr
gt; Next RowNdx

--

Dave Peterson

Cheers Dave,

That seems to work great.

Thanks for your help.

RichHi Rich,
I can confirm the 23 undone salons using EndRow =
Cells(Rows.Count,quot;Aquot;.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