FWIW
This can be optimized further if you assign the cell containing the
title name a fully relative defined name. For example...

Select G3
On "By Category":
Define a sheet scope name "TitleName"
Tab to the RefersTo box
Select the cell containing the name in row4
Press F2 to enter EditMode in the RefersTo box
Remove the sheetname and any $ symbols

Do this on all 3 sheets. Now you can run this single routine...


Sub Copy_Titles2()
' Run to automate setting titles
Dim lLastRow&, n&, lCol&, sTitle$
Const sAltTitle$ = "Other Activities"
Const sAltVals$ = "zOther Activities,Monthly,zy"

lCol = Columns("G").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Application.ScreenUpdating = False
For n = 3 To lLastRow
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
With Cells(n, lCol)
.Formula = "=TitleName" '//set title
.Value = IIf(InStr(sAltVals, .Value) 0, sAltTitle, .Value)

'Format font
With .Font
.Name = "Calibri": .Size = 11
.Bold = True: .Underline = xlUnderlineStyleSingle
End With '.Font

'Set alignment
.HorizontalAlignment = xlLeft
End With
End If
End With
Next 'n
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion