I've not used Themes before, so I'm not completely sure of the property
calls, but I can't find the property calls you are making for the Range
object you appear to be selecting. However, you say your code is working, so
I'll take your word for that.<g> Given that, here is how I would rearrange
your code to simplify it...
Sub DatesWithQuarters()
Dim X As Long, Col As Long, Rw As Long
Dim StartDate As Variant, Duration As Variant
Rw = 2 ' This is the row to place the list on
Col = 5 ' This is the starting column for the list
StartDate = InputBox("Tell me the starting month and 4-digit year")
Duration = InputBox("How many months should be listed?")
If IsDate(StartDate) And Len(Duration) > 0 And _
Not Duration Like "*[!0-9]*" Then
If Duration > 0 Then
With Cells(Row, Col).Resize(, Duration + Int(Duration / 3))
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
StartDate = CDate(StartDate)
For X = 0 To Duration - 1
Cells(Rw, Col).NumberFormat = "mmm-yyyy"
Cells(Rw, Col).Value = DateAdd("m", X, StartDate)
If Month(DateAdd("m", X, StartDate)) Mod 3 = 0 And X > 0 Then
Col = Col + 1
Cells(Rw, Col).NumberFormat = "@"
Cells(Rw, Col).Value = Format(DateAdd("m", X, _
StartDate), "\Qq-yyyy")
Cells(Rw, Col).Interior.TintAndShade = -0.2
End If
Col = Col + 1
Next
End If
End If
End Sub
What I have done is take the starting cell, expand it by the duration and
apply all the formatting for a non-quarter cell to them all at once before
the loop; then, in the loop, I change the .TintAndShade property value for
the quarters in the If/Then block for the quarters.
--
Rick (MVP - Excel)
Hugo said:
Thanks again, Rick.
I have the following to try to format the color and text of the output in
a
way I would like:
Sub DatesWithQuarters()
Dim X As Long, Col As Long, Row As Long
Dim StartDate As Variant, Duration As Variant
Col = 5
Row = 6
StartDate = Range("c4")
Duration = Range("c5")
If IsDate(StartDate) And Len(Duration) > 0 And _
Not Duration Like "*[!0-9]*" Then
If Duration > 0 Then
StartDate = CDate(StartDate)
For X = 0 To Duration - 1
Cells(Row, Col).NumberFormat = "mmm-yy"
Cells(Row, Col).Value = DateAdd("m", X, StartDate)
Cells(Row, Col).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
If Month(DateAdd("m", X, StartDate)) Mod 3 = 0 And X > 0 Then
Col = Col + 1
Cells(Row, Col).NumberFormat = "@"
Cells(Row, Col).Value = Format(DateAdd("m", X, _
StartDate), "\Qq-yy")
Cells(Row, Col).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.2
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
Col = Col + 1
Next
End If
End If
End Sub
However, this subroutine goes cell by cell to format text and fill. Is
there a way to achieve the same thing all at once? Also, how would I
clear
the output area before this subroutine writes the information to the
cells?
Thanks!
--
Hugo
Rick Rothstein said:
The first argument in the Cells property call handles the rows. Here is
the
code modified to set the row using a single variable (named Rw)...
Sub DatesWithQuarters()
Dim X As Long, Col As Long, Rw As Long
Dim StartDate As Variant, Duration As Variant
Rw = 2 ' This is the row to place the list on
Col = 5 ' This is the starting column for the list
StartDate = InputBox("Tell me the starting month and 4-digit year")
Duration = InputBox("How many months should be listed?")
If IsDate(StartDate) And Len(Duration) > 0 And _
Not Duration Like "*[!0-9]*" Then
If Duration > 0 Then
StartDate = CDate(StartDate)
For X = 0 To Duration - 1
Cells(Rw, Col).NumberFormat = "mmm-yyyy"
Cells(Rw, Col).Value = DateAdd("m", X, StartDate)
If Month(DateAdd("m", X, StartDate)) Mod 3 = 0 And X > 0 Then
Col = Col + 1
Cells(Rw, Col).NumberFormat = "@"
Cells(Rw, Col).Value = Format(DateAdd("m", X, _
StartDate), "\Qq-yyyy")
End If
Col = Col + 1
Next
End If
End If
End Sub
--
Rick (MVP - Excel)
Hugo said:
Thanks, Rick. That is very helpful. Now if there is just a way to
change
the output so that I can put it in any cell. I see the "Col = 5" line,
but I
am not quite sure how to do something similar with rows.
--
Hugo
:
Something like this maybe?
Sub DatesWithQuarters()
Dim X As Long, Col As Long
Dim StartDate As Variant, Duration As Variant
Col = 5 ' This is the starting column for the list
StartDate = InputBox("Tell me the starting month and 4-digit year")
Duration = InputBox("How many months should be listed?")
If IsDate(StartDate) And Len(Duration) > 0 And _
Not Duration Like "*[!0-9]*" Then
If Duration > 0 Then
StartDate = CDate(StartDate)
For X = 0 To Duration - 1
Cells(1, Col).NumberFormat = "mmm-yyyy"
Cells(1, Col).Value = DateAdd("m", X, StartDate)
If Month(DateAdd("m", X, StartDate)) Mod 3 = 0 And X > 0 Then
Col = Col + 1
Cells(1, Col).NumberFormat = "@"
Cells(1, Col).Value = Format(DateAdd("m", X, _
StartDate), "\Qq-yyyy")
End If
Col = Col + 1
Next
End If
End If
End Sub
--
Rick (MVP - Excel)
Ryan,
Thanks for your help. That is not quite what I am looking for, but
perhaps
it can be a good starting place.
I am really trying to get someting where the months and quarters are
in
the
output (i.e. in one row there will be an output of three months,
followed
by
the fiscal quarter that describes those three months, followed by
the
next
three months, followed by the quarter that describes those next
three
months,
etc.)
--
Hugo
:
How about this:
Sub BeginMonth()
Dim Mth As String
Dim Nbr As Long
Mth = InputBox("Please enter a beginning month.")
Range("C5").Select
ActiveCell = Mth
Nbr = CLng(Application.InputBox _
(prompt:="Please enter total number of months.", Type:=1))
Range("Z1").Select
ActiveCell = Nbr
Range("C5").Select
Selection.AutoFill Destination:=Range _
(Selection, Selection.Resize(1, Nbr))
End Sub
HTH,
Ryan---
--
Ryan---
If this information was helpful, please indicate this by clicking
''Yes''.
:
Hi,
I am new to writing in VBA, but I would like to write a function,
where
the
inputs are a start date and an end date (month&year), and the
output
is
a
range in a single row of an indefinite number of columns (to be
determined by
how muhc time is between the starting date and the ending date).
I
would
like the output to be in the form of showing the month and year,
and
at
the
end of every fiscal quarter showing the quarter and year. For
example
the
output would look like the following, where a comma shows where a
break
between cells in a row occurs:
"Jan-2009, Feb-2009, Mar-2009, Q1-2009, Apr-2009,..."
Any tips would be greatly appreciated. I assume I will have to
write
this
as a function not a subroutine, but would appreciate hearing
suggestions.
Thanks!
