Hi,
I am looking to have a universal solution to adding a row in multiple sheets
at the same time.
Here is a macro I recorded which will add a row at row20 and copy formulas
in certain columns

'select tabs
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Usual V to Z", " Usual R to U", _
" Usual Pto", " Usual P", " Usual H to O", _
" Usual F to G", " Usual C to E", " Usual B", _
" Usual A")).Select
Sheets("Usual A").Activate

'select row
Rows("20:20").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'filldown formula cells
Range("A19").Select
Selection.AutoFill Destination:=Range("A19:A20"), Type:=xlFillDefault
Range("A19:A20").Select
Range("C19").Select
Selection.AutoFill Destination:=Range("C19:C20"), Type:=xlFillDefault
Range("C19:C20").Select
Range("E19").Select
Selection.AutoFill Destination:=Range("E19:E20"), Type:=xlFillDefault
Range("E19:E20").Select
' ungroup sheets
Sheets("Usual A").Select
Range("B9").Select

The only problem with this macro is that it can only be used in its current
state to add a row at row20.

I need to be able to run code that adds a row based on which cell is
selected in column B

So for example if B31 is selected then the code would determine this is the
row where a row is to be added.
All the actions of the macro would then be run.

Hope someone can grasp what I am hoping to achieve, thank you if you can help.

You should try turning on the "LIST" feature for your dataset. Put your
cursor in the data and press CTRL-L to activate the "List" wizard.

Once it is on, you'll see an "expansion row" offered at the bottom of your
data. If you type ANYTHING in that row, Excel will expand the "LIST" to
encompass this row permanently and it will copy any formulas from the row
above into that row as well as formatting.

This will also work if you click on a row in the middle of the data and
select "insert row". The "List" will always make sure new rows have the
needed and formatting and formulas.


-----
"Actually, I *am* a rocket scientist." -- JB
(www.MadRocketScientist.com)

Your feedback is appreciated, click YES if this post helped you.


"Gotroots" wrote:

Hi,
I am looking to have a universal solution to adding a row in multiple sheets
at the same time.
Here is a macro I recorded which will add a row at row20 and copy formulas
in certain columns

'select tabs
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Usual V to Z", " Usual R to U", _
" Usual Pto", " Usual P", " Usual H to O", _
" Usual F to G", " Usual C to E", " Usual B", _
" Usual A")).Select
Sheets("Usual A").Activate

'select row
Rows("20:20").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'filldown formula cells
Range("A19").Select
Selection.AutoFill Destination:=Range("A19:A20"), Type:=xlFillDefault
Range("A19:A20").Select
Range("C19").Select
Selection.AutoFill Destination:=Range("C19:C20"), Type:=xlFillDefault
Range("C19:C20").Select
Range("E19").Select
Selection.AutoFill Destination:=Range("E19:E20"), Type:=xlFillDefault
Range("E19:E20").Select
' ungroup sheets
Sheets("Usual A").Select
Range("B9").Select

The only problem with this macro is that it can only be used in its current
state to add a row at row20.

I need to be able to run code that adds a row based on which cell is
selected in column B

So for example if B31 is selected then the code would determine this is the
row where a row is to be added.
All the actions of the macro would then be run.

Hope someone can grasp what I am hoping to achieve, thank you if you can help.

Hi GotRoots

This will add a row to all the sheets which start with the word
"Usual". It runs based on the cell selected. It assumes you are
running the code when you have the cursor placed in the last cell with
formula in it. Modify to suit.

Take care

Marcus


Option Explicit
Option Compare Text

Sub AddRowtoAll()

Dim ws As Worksheet
Dim AR As Integer 'active row

AR = Selection.Row

For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 5) = "Usual" Then
ws.Range("A" & AR + 1).EntireRow.Insert
ws.Range("A" & AR).Copy ws.Range("A" & AR + 1)
End If

Next ws

End Sub

Not sure what you mean here;
It assumes you are running the code when you have the cursor placed in the last cell with formula in it.


Perhaps a another way way maybe to pre-select a row first before running the
code.

Here is what I done with the code supplied, which created an error:

The code was inserted into ThisWorkbook
I then run the code via a command button

Private Sub TestAddRow_Click()
AddRowtoAll
End Sub

Got a compile error:
Sub or Function not defined


"marcus" wrote:

Hi GotRoots

This will add a row to all the sheets which start with the word
"Usual". It runs based on the cell selected. It assumes you are
running the code when you have the cursor placed in the last cell with
formula in it. Modify to suit.

Take care

Marcus


Option Explicit
Option Compare Text

Sub AddRowtoAll()

Dim ws As Worksheet
Dim AR As Integer 'active row

AR = Selection.Row

For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 5) = "Usual" Then
ws.Range("A" & AR + 1).EntireRow.Insert
ws.Range("A" & AR).Copy ws.Range("A" & AR + 1)
End If

Next ws

End Sub
.

Gotroots

I made the bold assumption you would place this code in a Normal
Module (the same place your recorded macro is held). Of course if you
place the code in ThisWorkbook it will fail, placing it in any normal
module or even one of the sheet modules would see it go like the
clappers.

How do you know which row you want the formula copied from, you did
not say in your post. I just used the selected row as a starting
point. How about if you use the last USED Row in Column A as the row
you want to insert a line and pull the formula from the above cell.
This will accomplish this also with the addition of Columns C and E.
Please put this in a normal module.


Take care

Marcus

Option Explicit
Sub AddRowtoAll()
Dim ws As Worksheet
Dim AR As Integer 'active row

AR = Range("A" & Rows.Count).End(xlUp).Row 'Last used row in Col A,
Change to suit.

For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 5) = "Usual" Then
ws.Range("A" & AR + 1).EntireRow.Insert
ws.Range("A" & AR).Copy ws.Range("A" & AR + 1)
ws.Range("C" & AR).Copy ws.Range("C" & AR + 1)
ws.Range("E" & AR).Copy ws.Range("E" & AR + 1)
End If

Next ws

End Sub

Marcus

I didn't realise the code should not have been placed in ThisWorkbook sheet
€“ Im still learning :)

How do you know which row you want the formula copied from, you did
not say in your post.

There are around 8000 unique records in colB sorted alphabetically. When
additions are added these need to be entered in the appropriate location to
maintain the integrity of the alphabetical list.

How about if you use the last USED Row in Column A as the row
you want to insert a line and pull the formula from the above cell.

Every other column starting from €œA€� to €œBE€� contains a relative formula.
There are eight other sheets that contain identical data and formatting.
Using the last row will not be suitable as I would need to then sort all the
sheets With the amount of data and formulas in each sheet this would take a
very long time for a sheet calculation to be carried out.

So if a new record needs to be added then the location in the alphabetical
list is identified and the appropriate row is highlighted then when the code
is run it will know where to place an empty row.

What way should the code now be constructed to achieve this requirement?


"marcus" wrote:

Gotroots

I made the bold assumption you would place this code in a Normal
Module (the same place your recorded macro is held). Of course if you
place the code in ThisWorkbook it will fail, placing it in any normal
module or even one of the sheet modules would see it go like the
clappers.

How do you know which row you want the formula copied from, you did
not say in your post. I just used the selected row as a starting
point. How about if you use the last USED Row in Column A as the row
you want to insert a line and pull the formula from the above cell.
This will accomplish this also with the addition of Columns C and E.
Please put this in a normal module.


Take care

Marcus

Option Explicit
Sub AddRowtoAll()
Dim ws As Worksheet
Dim AR As Integer 'active row

AR = Range("A" & Rows.Count).End(xlUp).Row 'Last used row in Col A,
Change to suit.

For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 5) = "Usual" Then
ws.Range("A" & AR + 1).EntireRow.Insert
ws.Range("A" & AR).Copy ws.Range("A" & AR + 1)
ws.Range("C" & AR).Copy ws.Range("C" & AR + 1)
ws.Range("E" & AR).Copy ws.Range("E" & AR + 1)
End If

Next ws

End Sub
.

Hi Gotroots

OK so if I understand you correctly, you want to add data to the
bottom of Column B of a given sheet. Sort Column B so it is
alphabetical. Track the new edition to the list so its new position
after sorting is held in 'memory'. Then go through all the sheets
starting with the word 'Usual' and insert a row in the same place as
where your 'new edition' ended up after the sort.

So if you add a name like Smith for example and sort the list and
smith being unique is placed in Row 5600 say then you want to go
through to all the sheets called Usual and insert a row in Row 5600
and copy the formula from 5599 down to the new 5600.

The following code does the above. From the Sort to adding a row in
the necessary sheets, copying the formula from the cell above from Row
A to BE. Now open up the visual basic editor ALT + F11 - goto Insert
- Module. Now paste the following code in the module.

Lastly and very importantly place your cursor at the bottom of column
B where you have just placed a new entry and run the following
procedure. Tools Macros, RUN.

Good luck with this. If this is not clear post back.

Take care

Marcus

Option Explicit
Option Compare Text

Sub AddRowtoAll()
Dim rng As Range
Dim lr As Long
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim FD As String 'find string
Dim Frow As Integer 'found row
Dim sel As String

Application.ScreenUpdating = False

Set sh = ActiveSheet
FD = ActiveCell.Value
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("B2:B" & lr)
sel = Selection.Address
rng.Sort Range(sel), xlAscending

Frow = Range("B:B").Find(FD, LookIn:=xlValues).Row

For Each ws In ThisWorkbook.Worksheets

If Left((ws.Name), 5) = "Usual" Then
ws.Cells(Frow, 1).EntireRow.Insert
For i = 1 To 57 Step 2 'Change to extend if your Range
extends
ws.Cells(Frow - 1, i).Copy ws.Cells(Frow, i)
Next i
End If

Next ws

Application.ScreenUpdating = True

End Sub

Hello Marcus

I gave your code a try, but it did not complete the task fully.

OK so if I understand you correctly, you want to add data to the
bottom of Column B of a given sheet. Sort Column B so it is
alphabetical.

Sort the sheet by column B

Track the new edition to the list so its new position
after sorting is held in 'memory'. Then go through all the sheets
starting with the word 'Usual' and insert a row in the same place as
where your 'new edition' ended up after the sort.

No other sheets starting with the word €˜Usual had a row inserted into them.

lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
what does Rows.Count, 2 refer to as a matter of interest

Set rng = sh.Range("B2:B" & lr)
I have changed this to B10:B as this is the range the data is in

rng.Sort Range(sel), xlAscending
the sort needs to take in the whole sheet and sort on €œB€�

If Left((ws.Name), 5) = "Usual" Then
I presume 5 means the first 5 characters from the left of the sheet name,
these sheets were not processed

Thanks for helping me out Marcus.


"marcus" wrote:

Hi Gotroots

OK so if I understand you correctly, you want to add data to the
bottom of Column B of a given sheet. Sort Column B so it is
alphabetical. Track the new edition to the list so its new position
after sorting is held in 'memory'. Then go through all the sheets
starting with the word 'Usual' and insert a row in the same place as
where your 'new edition' ended up after the sort.

So if you add a name like Smith for example and sort the list and
smith being unique is placed in Row 5600 say then you want to go
through to all the sheets called Usual and insert a row in Row 5600
and copy the formula from 5599 down to the new 5600.

The following code does the above. From the Sort to adding a row in
the necessary sheets, copying the formula from the cell above from Row
A to BE. Now open up the visual basic editor ALT + F11 - goto Insert
- Module. Now paste the following code in the module.

Lastly and very importantly place your cursor at the bottom of column
B where you have just placed a new entry and run the following
procedure. Tools Macros, RUN.

Good luck with this. If this is not clear post back.

Take care

Marcus

Option Explicit
Option Compare Text

Sub AddRowtoAll()
Dim rng As Range
Dim lr As Long
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim FD As String 'find string
Dim Frow As Integer 'found row
Dim sel As String

Application.ScreenUpdating = False

Set sh = ActiveSheet
FD = ActiveCell.Value
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("B2:B" & lr)
sel = Selection.Address
rng.Sort Range(sel), xlAscending

Frow = Range("B:B").Find(FD, LookIn:=xlValues).Row

For Each ws In ThisWorkbook.Worksheets

If Left((ws.Name), 5) = "Usual" Then
ws.Cells(Frow, 1).EntireRow.Insert
For i = 1 To 57 Step 2 'Change to extend if your Range
extends
ws.Cells(Frow - 1, i).Copy ws.Cells(Frow, i)
Next i
End If

Next ws

Application.ScreenUpdating = True

End Sub
.

Hi Gootroots

Strange that it does not work for you, in my mochup it works
perfectly. Maybe I'll send you the spreadsheet and you will see it
working OK.

lr = sh.Cells(Rows.Count, 2).End(xlUp).Row

The above line gets the integer value of the last used row in Column
B. So if you enter your new unique identifyer at the bottom of
column, B before the sort, it will assign the row number to the unique
identifyer entered. If say you entered the unique value in cell B8001
then LR would = 8001. You do this to get the used range in Column B
from B2 to B LR (being 8001). This would equal Sel in the next part
of the procedure.

rng.Sort Range(sel), xlAscending
the sort needs to take in the whole sheet and sort on “B”

I was not aware you wanted to sort the whole sheet I thought it was
just unique data in Col B of a sheet. Change the range (RNG) to equal
something like this

Set rng = sh.Range("A10:X" & lr)

Above X would be the last Column with Data in it, change to suit.
This will ensure that your whole range is sorted. The SEL range
explained above would be used as the criteria.

rng.Sort Range(sel), xlAscending

is sorting column B in Alpa ascending order. The range SEL is
assigned to B2 to B Last used row or B2:B8001 in the example above.

I presume 5 means the first 5 characters from the left of the sheet name,
these sheets were not processed

Yes this is correct 5 does cover the first 5 characters in the word
"Usual". These sheets were processed perfectly on my machine. Send
me your email address and I will post you a sample spreadsheet.

Take care and good luck.

Marcus

Hi Marcus,

A sample spreadsheet would be most helpful. Here is my email:
(remove sample from address)

I think we are close to nailing this Marcus.

Thank you

"marcus" wrote:


Hi Gootroots

Strange that it does not work for you, in my mochup it works
perfectly. Maybe I'll send you the spreadsheet and you will see it
working OK.

lr = sh.Cells(Rows.Count, 2).End(xlUp).Row

The above line gets the integer value of the last used row in Column
B. So if you enter your new unique identifyer at the bottom of
column, B before the sort, it will assign the row number to the unique
identifyer entered. If say you entered the unique value in cell B8001
then LR would = 8001. You do this to get the used range in Column B
from B2 to B LR (being 8001). This would equal Sel in the next part
of the procedure.

rng.Sort Range(sel), xlAscending
the sort needs to take in the whole sheet and sort on €œB€�

I was not aware you wanted to sort the whole sheet I thought it was
just unique data in Col B of a sheet. Change the range (RNG) to equal
something like this

Set rng = sh.Range("A10:X" & lr)

Above X would be the last Column with Data in it, change to suit.
This will ensure that your whole range is sorted. The SEL range
explained above would be used as the criteria.

rng.Sort Range(sel), xlAscending

is sorting column B in Alpa ascending order. The range SEL is
assigned to B2 to B Last used row or B2:B8001 in the example above.

I presume 5 means the first 5 characters from the left of the sheet name,
these sheets were not processed

Yes this is correct 5 does cover the first 5 characters in the word
"Usual". These sheets were processed perfectly on my machine. Send
me your email address and I will post you a sample spreadsheet.

Take care and good luck.

Marcus
.

I assume I leave out the three dots in your email as well. Let me
know if you got it on email.

Take care

Marcus

Marcus

My email does not include any dots except for .com, there are a total of 8
characters before @hotmail.com

Here is my email using the NATO phonetic alphabet:

mike
echo
papa
golf
lima
alfa
sierra
sierra


"marcus" wrote:

I assume I leave out the three dots in your email as well. Let me
know if you got it on email.

Take care

Marcus
.

Gootroots

The 'ass' at the end of your email did not show up on screen when I
was viewing it. Google groups have these last three characters as
dots. Which is most helpful but I guess protects you from spam bots
and the like. Will send this file tonight, it is on my laptop at
home.

Take care

Marcus

Sorry about all of this Marcus, but I do want to protect my email
sufficiently.

Look forward to receiving your spreadsheet.

Cheers
Gotroots

"marcus" wrote:

Gootroots

The 'ass' at the end of your email did not show up on screen when I
was viewing it. Google groups have these last three characters as
dots. Which is most helpful but I guess protects you from spam bots
and the like. Will send this file tonight, it is on my laptop at
home.

Take care

Marcus
.

Hi Gotroots

Let me know how you go as I posted it two nights ago now. The mail
did not bounce, so I will assume you got it and are working on the
problem.

Take care

Marcus

Marcus

I had to leave it for a while due to other commitments. Planning to get back
with you shortly.

Thank you.

Gotroots

"marcus" wrote:

Hi Gotroots

Let me know how you go as I posted it two nights ago now. The mail
did not bounce, so I will assume you got it and are working on the
problem.

Take care

Marcus
.