I have an Excel Spreadsheet with rows of data in several categories.
Each category is separated by two blank rows. In column G, in the blank
cell immediately above each category, I write the category heading - a
process I have already automated using the macro Copy_Title.

To save having to manually run down column G and run Copy_Title in the
appropriate cells, I am now trying to write another macro which will
automate this task. However, my efforts have not achieved success so
far:


Sub Copy_Title_Auto()

Range("G2").Select

Dim LastRow As Long
Dim x As Long
Dim y As Long
y = ActiveCell.Column
LastRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
Application.ScreenUpdating = False
For x = LastRow To 2 Step -1
If Cells(x, y).Value = "" And Cells(x - 1, y).Value = "" Then
With Cells(x, y)
Call Copy_Title
End With
End If
Next x
Application.ScreenUpdating = True

End Sub


Can anyone help please?

Many thanks.

Call Copy_Title

Where's the code for this?

--
Garry

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

In article , lid says...

Call Copy_Title

Where's the code for this?

Surely you don't need that? The Copy_Title works perfectly and will do
so when called from this macro?

In article , lid says...

Call Copy_Title

Where's the code for this?

Surely you don't need that? The Copy_Title works perfectly and will
do so when called from this macro?

So how does it know which cell to act on???
Your 'With Cells(x, y) doesn't work because Copy_Title is not a
method of the Cells object...

--
Garry

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

In article , lid says...

In article , lid says...

Call Copy_Title

Where's the code for this?

Surely you don't need that? The Copy_Title works perfectly and will
do so when called from this macro?

So how does it know which cell to act on???
Your 'With Cells(x, y) doesn't work because Copy_Title is not a
method of the Cells object...

Thanks. So perhaps that's where I was going wrong...? What I tried to
write was a macro that would go up column G, calling the Copy_Title
macro every time it got to a cell where the cell and the one above were
blank. (This is exactly what I do manually at present!)

Hi,

Am Sun, 27 Mar 2016 10:09:07 +0100 schrieb Victor Delta:

Thanks. So perhaps that's where I was going wrong...? What I tried to
write was a macro that would go up column G, calling the Copy_Title
macro every time it got to a cell where the cell and the one above were
blank. (This is exactly what I do manually at present!)

you don't have to copy. You can refer correctly to your Author. Modify
in the code "your title" to the cell you wanted to copy:

Sub Test()
Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, 7).End(xlUp).Row
For i = LastRow To 2 Step -1
If IsEmpty(Cells(i, 7)) And IsEmpty(Cells(i - 1, 7)) Then
Cells(i, 7) = "your title"
End If
Next
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

In article , says...

Hi,

Am Sun, 27 Mar 2016 10:09:07 +0100 schrieb Victor Delta:

Thanks. So perhaps that's where I was going wrong...? What I tried to
write was a macro that would go up column G, calling the Copy_Title
macro every time it got to a cell where the cell and the one above were
blank. (This is exactly what I do manually at present!)

you don't have to copy. You can refer correctly to your Author. Modify
in the code "your title" to the cell you wanted to copy:

Sub Test()
Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, 7).End(xlUp).Row
For i = LastRow To 2 Step -1
If IsEmpty(Cells(i, 7)) And IsEmpty(Cells(i - 1, 7)) Then
Cells(i, 7) = "your title"
End If
Next
End Sub


Regards
Claus B.

Claus

Very many thanks.

V

In article ,
says...

In article , says...

Hi,

Am Sun, 27 Mar 2016 10:09:07 +0100 schrieb Victor Delta:

Thanks. So perhaps that's where I was going wrong...? What I tried to
write was a macro that would go up column G, calling the Copy_Title
macro every time it got to a cell where the cell and the one above were
blank. (This is exactly what I do manually at present!)

you don't have to copy. You can refer correctly to your Author. Modify
in the code "your title" to the cell you wanted to copy:

Sub Test()
Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, 7).End(xlUp).Row
For i = LastRow To 2 Step -1
If IsEmpty(Cells(i, 7)) And IsEmpty(Cells(i - 1, 7)) Then
Cells(i, 7) = "your title"
End If
Next
End Sub


Regards
Claus B.

Claus

Very many thanks.

V

Just tried it and it doesn't work as I'd hoped.

Sorry Claus, I realise I perhaps didn't explain it very well. The
'Copy_Title' (perhaps a misleading name) macro is actually quite complex
as it pulls together data from various different places to form the
title of each category.

So that's why I wanted the new macro to run the 'Copy_Title' macro when
it got to each appropriate cells in column G.

Hope this is clearer now.

Hi,

Am Sun, 27 Mar 2016 19:00:10 +0100 schrieb Victor Delta:

Sorry Claus, I realise I perhaps didn't explain it very well. The
'Copy_Title' (perhaps a misleading name) macro is actually quite complex
as it pulls together data from various different places to form the
title of each category.

can you give an example of the table with the values?
You can pick the values are via Application.VLOOKUP or Application.MATCH
but therefore we need the layout of the data table and the condition to
find the correct title.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Try revising your Copy_Title routine to accept an optional arg for a
range...


Sub Copy_Title(Optional Rng As Range)

If Rng Is Nothing Then Set Rng = ActiveCell

...then adjust all its target cell ref code to use Rng. This change
tells it which cell to act on -OR- you can call it from another sub
(because it now has an arg) if you want to use it as you've been doing.

--
Garry

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

Tested example...

Sub Copy_Title_Auto()
' Run to automate setting titles
Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next 'n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub

Sub CopyTitle_OneTime()
' Run to manually set titles
Copy_Title
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

In article , lid says...

Tested example...

Sub Copy_Title_Auto()
' Run to automate setting titles
Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next 'n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub

Sub CopyTitle_OneTime()
' Run to manually set titles
Copy_Title
End Sub

Many thanks Garry. Have played around with this today but can't get it
running quite as I want. At present, the new macro runs well but only
inserts "Title goes here" in the appropriate cells. The modified code
now looks like this (see notes below):

Sub Copy_Title_Auto()
' Run to automate setting titles

Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Range("G3").Select
Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

Dim s As String
s = ActiveSheet.Name
If s = "By Category" Then Call Copy_Cat_Name
If s = "By Day" Then Call Copy_Day_Name
If s = "By Location" Then Call Copy_Loc_Name

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub


I inserted the "Range("G3").Select" line to stop macro also displaying
"Title goes here" in whatever cell is selected before the macro is run.
(G3 is always the top title box on each sheet).

The 2nd macro now includes the same code as the Copy_Title macro.

Any ideas please? Thanks.

In article , lid says...

Tested example...

Sub Copy_Title_Auto()
' Run to automate setting titles
Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next 'n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub

Sub CopyTitle_OneTime()
' Run to manually set titles
Copy_Title
End Sub

Many thanks Garry. Have played around with this today but can't get
it running quite as I want. At present, the new macro runs well but
only inserts "Title goes here" in the appropriate cells. The
modified code now looks like this (see notes below):

Sub Copy_Title_Auto()
' Run to automate setting titles

Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Range("G3").Select
Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

Dim s As String
s = ActiveSheet.Name
If s = "By Category" Then Call Copy_Cat_Name
If s = "By Day" Then Call Copy_Day_Name
If s = "By Location" Then Call Copy_Loc_Name

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub


I inserted the "Range("G3").Select" line to stop macro also
displaying "Title goes here" in whatever cell is selected before the
macro is run. (G3 is always the top title box on each sheet).

So why does your loop run from last row to row2? Should be...

For n = lLastRow To 3 Step - 1

...so it doesn't execute on row2. There's no reason to select any cells
if your blocks of data always are separated by 2 blank rows!

The 2nd macro now includes the same code as the Copy_Title macro.

Any ideas please? Thanks.

Victor,
My Copy_Title sub is a dummy imitation to place dummy title text
("Title goes here") in the expected manner. I suppose now you need some
way to get the results of the 3 called routines so they can pass the
appropriate title back to the caller. I suggest you make these
functions and use a variable to store the expected title...

Sub Copy_Title(Optional Rng As Range)

Dim sTitle$
If Rng Is Nothing Then Set Rng = ActiveCell

Select Case ActiveSheet.Name
Case "By Category": sTitle = Get_Category
Case "By Day": sTitle = Get_Day
Case "By Location": sTitle = Get_Location
End Select
Rng.Value = sTitle

End Sub

...where each function returns the expected value. If these need to know
which cell is being acted on then they'll also need this as an arg...

Sub Copy_Title(Optional Rng As Range)

If Rng Is Nothing Then Set Rng = ActiveCell

Select Case ActiveSheet.Name
Case "By Category": Rng.Value = Get_Category(Rng)
Case "By Day": Rng.Value = Get_Day(Rng)
Case "By Location": Rng.Value = Get_Location(Rng)
End Select
End Sub

...where I've shown that optionally the variable 'sTitle' isn't needed.
Sample functions follow...

Function Get_Category$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Category = <ProcessResult
End Function

Function Get_Day$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Day = <ProcessResult
End Function

Function Get_Location$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Location = <ProcessResult
End Function

...but without seeing the actual code I can only show concept here. If
you provide the code for these routines then perhaps I can deliver an
optimized solution...

--
Garry

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

In article , lid says...
Many thanks Garry. Have played around with this today but can't get
it running quite as I want. At present, the new macro runs well but
only inserts "Title goes here" in the appropriate cells. The
modified code now looks like this (see notes below):

Sub Copy_Title_Auto()
' Run to automate setting titles

Dim lLastRow&, n&, lCol&

lCol = Range("G2").Column
lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row

Range("G3").Select
Application.ScreenUpdating = False
For n = lLastRow To 2 Step -1
With Cells(n, lCol)
If .Value = "" And .Offset(-1).Value = "" Then
Copy_Title Cells(n, lCol)
End If
End With
Next n
Application.ScreenUpdating = True

End Sub

Sub Copy_Title(Optional Rng As Range)
' Dummy routine to imitate whatever this does

Dim s As String
s = ActiveSheet.Name
If s = "By Category" Then Call Copy_Cat_Name
If s = "By Day" Then Call Copy_Day_Name
If s = "By Location" Then Call Copy_Loc_Name

If Rng Is Nothing Then Set Rng = ActiveCell
Rng.Value = "Title goes here"

End Sub


I inserted the "Range("G3").Select" line to stop macro also
displaying "Title goes here" in whatever cell is selected before the
macro is run. (G3 is always the top title box on each sheet).

So why does your loop run from last row to row2? Should be...

For n = lLastRow To 3 Step - 1

...so it doesn't execute on row2. There's no reason to select any cells
if your blocks of data always are separated by 2 blank rows!

The 2nd macro now includes the same code as the Copy_Title macro.

Any ideas please? Thanks.

Victor,
My Copy_Title sub is a dummy imitation to place dummy title text
("Title goes here") in the expected manner. I suppose now you need some
way to get the results of the 3 called routines so they can pass the
appropriate title back to the caller. I suggest you make these
functions and use a variable to store the expected title...

Sub Copy_Title(Optional Rng As Range)

Dim sTitle$
If Rng Is Nothing Then Set Rng = ActiveCell

Select Case ActiveSheet.Name
Case "By Category": sTitle = Get_Category
Case "By Day": sTitle = Get_Day
Case "By Location": sTitle = Get_Location
End Select
Rng.Value = sTitle

End Sub

...where each function returns the expected value. If these need to know
which cell is being acted on then they'll also need this as an arg...

Sub Copy_Title(Optional Rng As Range)

If Rng Is Nothing Then Set Rng = ActiveCell

Select Case ActiveSheet.Name
Case "By Category": Rng.Value = Get_Category(Rng)
Case "By Day": Rng.Value = Get_Day(Rng)
Case "By Location": Rng.Value = Get_Location(Rng)
End Select
End Sub

...where I've shown that optionally the variable 'sTitle' isn't needed.
Sample functions follow...

Function Get_Category$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Category = <ProcessResult
End Function

Function Get_Day$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Day = <ProcessResult
End Function

Function Get_Location$(Optional Rng As Range)
'whatever process this is needs to load the resulting value like so...
Get_Location = <ProcessResult
End Function

...but without seeing the actual code I can only show concept here. If
you provide the code for these routines then perhaps I can deliver an
optimized solution...

--
Garry

============================================

Garry

Many thanks for all your efforts. I can supply the other macros code but
what really puzzles me is why this is becoming so very complicated?

At present, I simply go (manually) to the appropriate cells in Col G
(starting with G3) and invoke the Copy_Title macro using the shortcut
Ctrl + T. Having now created another macro which can go to the cells in
question, why is it not possible to make it similarly run the macro in
each cell?

Sorry if this is a stupid question but, as you can tell, my knowledge of
VB is fairly limited!

Thanks for your patience.

By the way, I totally agree with you about running the loop to row 3 (ie
cell G3) but I find that the macro still also operates on the cell in
which the cursor starts - whatever row or column it's in. Hence my
probably rather heavy-handed "Range("G3").Select" to try and overcome
this problem.

V

Garry

Many thanks for all your efforts. I can supply the other macros code
but
what really puzzles me is why this is becoming so very complicated?

Well it's a rather simple task IMO, but I suspect that (as you state
below) your limited knowledge of VB is the major issue. Post your other
macro code -OR- upload your file to a public share and post a download
link so I can edit it and return to you.

At present, I simply go (manually) to the appropriate cells in Col G
(starting with G3) and invoke the Copy_Title macro using the shortcut
Ctrl + T. Having now created another macro which can go to the cells
in
question, why is it not possible to make it similarly run the macro
in
each cell?

I suspect your code operates on the premise the target cell is the
active cell. Since your loop changes the target cell each iteration,
your code needs to ref the next cell to act on.

My code requires no cells be selected as doing so generally results
inefficient performance.

Sorry if this is a stupid question but, as you can tell, my knowledge
of
VB is fairly limited!

Thanks for your patience.

Always glad to help...

By the way, I totally agree with you about running the loop to row 3
(ie
cell G3) but I find that the macro still also operates on the cell in
which the cursor starts - whatever row or column it's in. Hence my
probably rather heavy-handed "Range("G3").Select" to try and overcome
this problem.

This absolutely does not happen with my test data, using my code 'as
posted'.

V

--
Garry

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

In article , lid says...

Garry

Many thanks for all your efforts. I can supply the other macros code
but
what really puzzles me is why this is becoming so very complicated?

Well it's a rather simple task IMO, but I suspect that (as you state
below) your limited knowledge of VB is the major issue. Post your other
macro code -OR- upload your file to a public share and post a download
link so I can edit it and return to you.

At present, I simply go (manually) to the appropriate cells in Col G
(starting with G3) and invoke the Copy_Title macro using the shortcut
Ctrl + T. Having now created another macro which can go to the cells
in
question, why is it not possible to make it similarly run the macro
in
each cell?

I suspect your code operates on the premise the target cell is the
active cell. Since your loop changes the target cell each iteration,
your code needs to ref the next cell to act on.

My code requires no cells be selected as doing so generally results
inefficient performance.

Sorry if this is a stupid question but, as you can tell, my knowledge
of
VB is fairly limited!

Thanks for your patience.

Always glad to help...

By the way, I totally agree with you about running the loop to row 3
(ie
cell G3) but I find that the macro still also operates on the cell in
which the cursor starts - whatever row or column it's in. Hence my
probably rather heavy-handed "Range("G3").Select" to try and overcome
this problem.

This absolutely does not happen with my test data, using my code 'as
posted'.

V

Garry

Many thanks. Here's the 'suite' of Copy_Title macros:

Sub Copy_Cat_Name()
'
' Copy_Cat_Name Macro
' Macro recorded 16/01/2012

ActiveCell.Select
ActiveCell.FormulaR1C1 = "=R[1]C[-5]"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
If ActiveCell.Value = "zOther Activities" Then
ActiveCell.Value = "Other Activities"
End If
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.Resize(1, 7).Select
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
End With
End Sub


Sub Copy_Day_Name()
'
' Copy_Day_Name Macro
' Macro recorded 16/01/2012
'

ActiveCell.Select
ActiveCell.FormulaR1C1 = "=R[1]C[0]"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
If ActiveCell.Value = "Monthly" Then
ActiveCell.Value = "Other Activities"
End If
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.Resize(1, 7).Select
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
End With
End Sub


Sub Copy_Loc_Name()
'
' Copy_Loc_Name Macro
' Macro recorded 16/01/2012
'

ActiveCell.Select
ActiveCell.FormulaR1C1 = "=R[1]C[8]"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
If ActiveCell.Value = "zy" Then
ActiveCell.Value = "Other Activities"
End If
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.Resize(1, 6).Select
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
End With
End Sub


Sub Copy_Title()
' shortcut ctrl+t
' Invokes appropriate copy/format macro depending on worksheet

Dim s As String
s = ActiveSheet.Name
If s = "By Category" Then Call Copy_Cat_Name
If s = "By Day" Then Call Copy_Day_Name
If s = "By Location" Then Call Copy_Loc_Name

End Sub


Hope you can make sense of them!

Thanks again

V

Okay, this is what I suspected was happening as they all depend on the
target cell being selected. IMO, this is way more complicated than it
needs to be. Easier for me to revise your file than explain how to
simplify and optimize the entire process. If interested, post a
download link. If you include your email address somewhere
(CustomProperty?) I'll email it right to you...

--
Garry

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

Curious why you merge?

--
Garry

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

Here's one approach...

Sub CopyTitle()
' To manually set single titles
Get_Title
End Sub

Sub SetTitles()
' To automate setting multiple titles
Dim lLastRow&, n&, lCol&

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
Get_Title Cells(n, lCol)
End If
End With
Next 'n
Application.ScreenUpdating = True

End Sub

Sub Get_Title(Optional Rng As Range)

If Rng Is Nothing Then Set Rng = ActiveCell
Const sAltTitle$ = "Other Activities"

Select Case ActiveSheet.Name
Case "By Category"
With Rng
.Value = .Offset(1, -5) '//set title
If .Value = "zOther Activities" Then .Value = sAltTitle
.Resize(1, 7).Merge
End With 'Rng
Call Format_Titles(Rng)

Case "By Day"
With Rng
.Value = .Offset(1, 0) '//set title
If .Value = "Monthly" Then .Value = sAltTitle
.Resize(1, 7).Merge
End With 'Rng
Call Format_Titles(Rng)

Case "By Location"
With Rng
.Value = .Offset(1, 8) '//set title
If .Value = "zy" Then .Value = sAltTitle
.Resize(1, 6).Merge
End With 'Rng
Call Format_Titles(Rng)
End Select 'Case ActiveSheet.Name
End Sub

Sub Format_Titles(Optional Rng As Range)
If Rng Is Nothing Then Set Rng = ActiveCell
With Rng
'Format font
With .Font
.Name = "Calibri": .Size = 11
.Bold = True: .Underline = xlUnderlineStyleSingle
End With '.Font

'Set alignment
.HorizontalAlignment = xlLeft
End With 'Rng
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

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

In article , lid says...

Here's one approach...

Sub CopyTitle()
' To manually set single titles
Get_Title
End Sub

Sub SetTitles()
' To automate setting multiple titles
Dim lLastRow&, n&, lCol&

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
Get_Title Cells(n, lCol)
End If
End With
Next 'n
Application.ScreenUpdating = True

End Sub

Sub Get_Title(Optional Rng As Range)

If Rng Is Nothing Then Set Rng = ActiveCell
Const sAltTitle$ = "Other Activities"

Select Case ActiveSheet.Name
Case "By Category"
With Rng
.Value = .Offset(1, -5) '//set title
If .Value = "zOther Activities" Then .Value = sAltTitle
.Resize(1, 7).Merge
End With 'Rng
Call Format_Titles(Rng)

Case "By Day"
With Rng
.Value = .Offset(1, 0) '//set title
If .Value = "Monthly" Then .Value = sAltTitle
.Resize(1, 7).Merge
End With 'Rng
Call Format_Titles(Rng)

Case "By Location"

Garry

Thank you so much for all your hard work. This looks great. However,
when I run the new CopyTitle macro, it only operates on the cell where
the cursor is - when it's G3, the correct title is inserted for the top
group of data - but it doesn't do anything on the rest of the sheet...?

Should I have mentioned that I'm using Excel 2003 in case that is
relevant?

Finally, the merge line is just to improve the overall appearance of the
data titles.

V

Garry

Thank you so much for all your hard work. This looks great. However,
when I run the new CopyTitle macro, it only operates on the cell
where
the cursor is - when it's G3, the correct title is inserted for the
top
group of data - but it doesn't do anything on the rest of the
sheet...?
The new macro does all sections on my test sheet, so I suspect you did
not do the defined names correctly.

Should I have mentioned that I'm using Excel 2003 in case that is
relevant?

Here's how to do the defined names for each sheet in xl2003...

Delete all existing names;

Select G3;

Open the Define Names dialog;

Type in the NameBox like this...

'sheet1'!TitleName

..where you need to replace "sheet1" with the actual sheetname;
*Note:* this accounts for the space in the sheetname. I don't use
spaces so I never need to include the apostrophes. Sometimes I'll
use an underscore...
"2016" or "2016_Jan"
"ByDay" or "By_Day"
..for example, so I just have to type "2016!DefinedName"

Tab into the RefersTo field and select the appropriate cell in row4
that contains the title name on that sheet;

Press F2 and use the left arrow key to position to remove the $
symbols so the RefersTo is fully relative;

Click Add and close the dialog.

Repeat for each sheet.

Finally, the merge line is just to improve the overall appearance of
the
data titles.

The title content will span adjacent cells anyway, making them 'appear'
as one cell. Merging isn't necessary, then, to achieve the desired
appearance. Additionally, the span adjusts automatically to the length
of the title name.

--
Garry

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

In article , lid says...

Garry

Thank you so much for all your hard work. This looks great. However,
when I run the new CopyTitle macro, it only operates on the cell
where
the cursor is - when it's G3, the correct title is inserted for the
top
group of data - but it doesn't do anything on the rest of the
sheet...?
The new macro does all sections on my test sheet, so I suspect you did
not do the defined names correctly.

Should I have mentioned that I'm using Excel 2003 in case that is
relevant?

Here's how to do the defined names for each sheet in xl2003...

Delete all existing names;

Select G3;

Open the Define Names dialog;

Type in the NameBox like this...

'sheet1'!TitleName

..where you need to replace "sheet1" with the actual sheetname;
*Note:* this accounts for the space in the sheetname. I don't use
spaces so I never need to include the apostrophes. Sometimes I'll
use an underscore...
"2016" or "2016_Jan"
"ByDay" or "By_Day"
..for example, so I just have to type "2016!DefinedName"

Tab into the RefersTo field and select the appropriate cell in row4
that contains the title name on that sheet;

Press F2 and use the left arrow key to position to remove the $
symbols so the RefersTo is fully relative;

Click Add and close the dialog.

Repeat for each sheet.

Finally, the merge line is just to improve the overall appearance of
the
data titles.


Many thanks. I'll see if I can get it working tomorrow.

V

Many thanks. I'll see if I can get it working tomorrow.

You're most welcome! If you have any problems make your file available
and I'll do it for you...

--
Garry

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

In article , lid says...

Many thanks. I'll see if I can get it working tomorrow.

You're most welcome! If you have any problems make your file available
and I'll do it for you...

Got it all working now. Very many thanks.

V

In article , lid says...

Many thanks. I'll see if I can get it working tomorrow.

You're most welcome! If you have any problems make your file
available and I'll do it for you...

Got it all working now. Very many thanks.

V

That's good to hear! Thanks for the feedback...

--
Garry

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