Thread
:
Excel macro - VBA code query
View Single Post
#
13
Posted to microsoft.public.excel.misc
GS[_6_]
external usenet poster
Posts: 1,182
Excel macro - VBA code query
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
Reply With Quote
GS[_6_]
View Public Profile
Find all posts by GS[_6_]