PDA

View Full Version : Autofill Across Columns with "Centered Across Formatted (3 Columns)" Quarterly Dates



kewiopex
12-09-2016, 11:06 AM
Dear Experts
I have searched and tried with no success to get a macro VBA for a date heading - " all dates are across 3 columns" - to progressively increment as the data gets filled for each new quarter So it would progressively go from Q3 2016 to Q4 2016 to Q1 2017 and so on. This macro would be initiated by the person to extend the dates in the series mentioned previously. A file with the setup is attached. In the original file, the action date row starts at row 21.

I did have each date as merged cells but after reading about the perils of using merge cells, I converted the heading into a "centered across" format.

I am trying to set this up so that others who are even less familiar with excel than me can just click a button to initiate a button.

I looked at the examples of autofill and tried to do a macro, but I am embarrassed to show the effort since it was using a merged cell approach but it failed.

Any help would be so welcomed.

p45cal
12-09-2016, 06:03 PM
You can do this but you must select one year's worth to autofill for further quarters.
In your file's case, select I2 to T2 before dragging to autofill, or F2 to Q2 etc.
Further playing reveals that any 12-cell selection will work.

There's a button in the attached which does this for row 2, one quarter at a time; it runs this macro:
Sub blah()
Set SourceRng = Cells(2, Columns.Count).End(xlToLeft).Offset(, -11).Resize(, 12)
SourceRng.AutoFill Destination:=SourceRng.Resize(, 17)
End Sub
To do this for row 21 instead of row 2 change the 2 in:
Set SourceRng = Cells(2, Columns.Count)…
to
Set SourceRng = Cells(21, Columns.Count)…

kewiopex
12-09-2016, 07:29 PM
Absolutely great ! And I thank you for this great support and fast reply to a need! You may not know, but this will help a number of people going forward to make their lives just a little more easier at work.

SamT
12-11-2016, 12:19 PM
Standard Module Code

Option Explicit

Sub AutoQtrRHeaders()
'Select any cell in the Row with the Qtr Headers before running this sub
'
'For Help, see: http://www.vbaexpress.com/forum/showthread.php?57967

Dim WorkingDate As Date
Dim WorkingQtr As String
Dim LC As Long 'LastColumn
Dim Rw As Long
Dim Cel As Range

Rw = Selection.Row

With Selection.Parent
Set Cel = .Cells(Rw, Columns.Count).End(xlToLeft)
LC = .Cells(Rw + 3, Columns.Count).End(xlToLeft).Column 'Rw + 3. "3" Depends on Sheet Layout
End With

WorkingQtr = Mid(Cel, 2, 1)
WorkingDate = GetDate(Cel)

Do While Cel.Column < LC - 3
Set Cel = Cel.Offset(, 3)
WorkingQtr = NextQtr(WorkingQtr)
WorkingDate = DateAdd("m", 3, WorkingDate)

Cel.Value = "Q" & WorkingQtr & " " & Year(WorkingDate)
Cel.Resize(1, 3).HorizontalAlignment = 7 'xlHAlignCenterAcrossSelection
Loop

End Sub


Private Function GetDate(Cel) As Date
Dim CurYear As String
Dim QtrStartDate As String

CurYear = Right(Cel, 4)

Select Case Mid(Cel, 2, 1)
Case "1": QtrStartDate = "01/01"
Case "2": QtrStartDate = "04/01"
Case "3": QtrStartDate = "07/01"
Case "4": QtrStartDate = "10/01"
End Select

GetDate = CDate(QtrStartDate & "/" & CurYear)
End Function


Private Function NextQtr(WorkingQtr As String) As String

Select Case WorkingQtr
Case "1": NextQtr = "2"
Case "2": NextQtr = "3"
Case "3": NextQtr = "4"
Case "4": NextQtr = "1"
End Select
End Function

kewiopex
12-11-2016, 01:22 PM
Marvelous SamT!
I will give it a go. I just discovered that another part of this same file has VBA coding that treats these dates as merge cells to do an averageifs calc. Any suggestions for doing the same treatment but using merge cells to advance by 1 quarter.

SamT
12-11-2016, 03:00 PM
Merged Cells are very weird.

For example, to refer to the topmost left cell of a block of cells, say A1:D4,
X = Range("A1").MergeArea.Cells(1).Value
Range().MergeArea is the entire block starting at A1, A1:D4

I thimksic that the same block can be referred to with Range(Any cell in Block).MergeArea, but don't quote me

Cells are counted from left to right then down. So .MergeArea.cells(1) would be A1, and .cells(5) would be A2, .Cells(16):=D4.


another part of this same file has VBA coding that treats these dates as merge cells to do an averageifs calc.

Not without seeing it. I would prefer to refactor all the code to avoid the use of Merged cells.

For example the three column Row of data under the 'Q' cells can be referred to with. for example:
Set rngData = Range(QCell).Offset(3, 0).Resize(1,3)


Any suggestions for doing the same treatment but using merge cells to advance by 1 quarter.
Set Qcell = Qcell.Offset(0, 3)

kewiopex
12-11-2016, 07:40 PM
SamT
Yeah you are right about the merge cells. I will need to see how best to determine to modify the averageifs calc to get to the last f=column and 8 quarters to the first column to achieve a 8 quarter dynamic period. I will take your suggestion to look at using the data to get the range.

It should be fun to see how I can do this. Once again, your support is overwhelming and appreciated. Many others will benefit from this.

Take care.

SamT
12-12-2016, 08:38 AM
On one project, I had to do Sumifs, SumIfAllSheets and other custom functions that referenced many different Cells/Rows.

I used hidden helper columns with certain values as "Street Signs" and "Street Addresses" that the Formula Functions could refer to.

My preferred style is to use Data Sheets and Report Sheets, with custom Object Properties in the Data Sheet Code Pages, and all but the simplest arithmetic on the Report Sheets performed by Code.

SamT
12-12-2016, 08:51 AM
Crude, probably not working, Custom Average Function:

Public Function Ave3rdQtr(Parameters)
Dim Total as Double
Dim q As Long
Dim Found As Range
Dim FirstFound Address As String

Set Found = SomeRange.Find("Q3")
If not Found is Nothing then
FirstFundAddress = Found.Address

Do
'Check other parameters
'If Parameters then
Total = Total + Found.Value
q = q + 1
Set Found = FindNext "Q3"
Loop While Found.Address <> FirstFoundAdress

If Not Found Is Nothing Then Ave3rdQtr = Tortal/q
End Function

kewiopex
12-12-2016, 12:44 PM
Hey SamT

I have not used helper cells but have come across the term and it did raise my interest as to what it was and how it works. I am slowly building some knowledge and look for other good ways and practices. I like your rule of thumb as to design of a good excel with report pages and working pages. I lot of these excels you inherit them and then have to work with what you have. But I do have an opportunity coming up that I can literally start afresh.

Your efforts give inspiration to we beginners and I thank you for this and all your hard work.

SamT
12-12-2016, 01:22 PM
aw shucks