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
.