How to Add New Month if date changes

[sourabh_ajmera]

Hello everybody,

I have an excel datasheet where there are dates in column and some data corresponding to the date in it. Each column only consists of a single date as header (always in row 1)

Now, I would to add a monthly average as the dates keep getting added in the datasheet on daily basis.

For example if the date is 9/1/2014 (september 1st) I would like to add a column of 'Sept-14' where I would see the avg of all sept dates.
Next month when the date 10/1/2014 (oct 1st) is added I would like the Oct-14 column to be added.

i.e for every 1st day of the month I would like to add a month column where i can avg all the month dates
But i dont want it to find only for 2014...in future it should work for 2015,2016 and so on as it is just addition of month

so i have tried something like this. but its incomplete

    Dim FindMon As Range
    Dim MonCol As Integer
    Dim MonColtxt As String
    Set FindMon = Rows(1).Find(What:="Jan", LookIn:=xlValues, LookAt:=xlWhole)
    MonCol = FindMon.Column
    MonColtxt = Replace(Cells(1, MonCol).Address(False, False), "1", "")
    If (MonColtxt = Jan) Then   'To find if that specific month column already exists or not
        End If
     Else
        Set FindDate = Rows(1).Find(What:="1/1*", LookIn:=xlValues, LookAt:=xlWhole)
        If (FindDate = 1 / 1 *) Then '<-- Here is where I want it to find the month but without the year..just the month and then add the resp month colum at the end

Please help. Thank you in advance

 

[venkat1926]

see the sample data will this help
formula in C2 is copied down
formla in D2 is array formula (control shift enter)
copy D2 to D3: D9
maximum data rows 1000
does it help you
Sheet1

*	A	B	C	D
1	DATE	DATA	MONTH NUMBR	AVG DATA
2	1/1/2014	1	1	1.5
3	1/7/2014	2	1	1.5
4	3/7/2014	3	3	3.5
5	3/9/2014	4	3	3.5
6	4/7/2014	5	4	5
7	5/7/2014	6	5	6
8	6/7/2014	7	6	7.5
9	6/2/2014	8	6	7.5

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:130.4px;"><col style="width:64px;"></colgroup><tbody>
</tbody>

Spreadsheet Formulas

Cell Formula C2 =MONTH(A2) D2 {=AVERAGEIFS($B$2:$B$1000,$C$2:$C$1000,C2)} <tbody> </tbody>

Formula Array: Produce enclosing { } by entering formula with CTRL+SHIFT+ENTER!

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

 

[sourabh_ajmera]

Hello Venkat1926,

I really appreciate your help and I am sure this will work. But, my database is huge. It goes upto 6000 lines averagely. Hence need a vba code that can do it.

Dates are placed in Row 1, always ...each date has it own column (date as a header).. I want to add month column (Sept-14) name if a new month starts on date (9/1/2014) and so on.
Hope this makes it more clear

Here's my version that I tried

Sub test()


    Dim FindMon As Range, FindDate As Range
    Dim LastCol As Integer
    Dim LastColtxt As String
    Set FindMon = Rows(1).Find(What:="Sep-14", LookIn:=xlValues, LookAt:=xlWhole)
    Set FindDate = Rows(1).Find(What:="9/1/14", LookIn:=xlValues, LookAt:=xlWhole)
    If (FindMon = "Sep-14" ) Then                                         '<--- To find if that specific month column already exists or not
        Exit Sub
     Else
     If (FindDate = "9/1/14") Then                                         '<--- If the month column doesnt exists add it after looking for the first date fo the month
            LastCol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
            LastColtxt = Replace(Cells(1, sLastCol).Address(False, False), "1", "")
        Columns(LastColtxt & ":" & LastColtxt).Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range(LastColtxt & "1").Select
        ActiveCell.FormulaR1C1 = "9/1/14"
        Range(LastColtxt & "2").Select
     End If
     End If
        
End Sub

 

[venkat1926]

quote Here's my version that I tried unquote
what happened.
post a very small extract of data

By the by the formulas can be copied down at one stroke. select C2:D2. take cursor at right bottom it becoems a plus + sign. click. the formlas will be copied at one stroke (as long as data is there in the previous column). this is only for information in future.

 

[sourabh_ajmera]

Hello Venkat,

I do agree that formulas can be copied down. But this is a small part of a HUGE macro that's already running and I do not want to do it manually in between/start/end and would also need the month name rather than month number.
Really appreciate the efforts you have put in. Thank you. But would be even better if you could help me with the vba code.

For your reference I am posting it again without the code block.

Sub test()


Dim FindMon As Range, FindDate As Range
Dim LastCol As Integer
Dim LastColtxt As String
Set FindMon = Rows(1).Find(What:="Sep*", LookIn:=xlValues, LookAt:=xlWhole)
Set FindDate = Rows(1).Find(What:="9/5/14", LookIn:=xlValues, LookAt:=xlWhole)
If (FindMon = "Sep-14") Then 'To find if that specific month column already exists or not
Exit Sub
Else
If (FindDate = "9/1/14") Then
LastCol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
LastColtxt = Replace(Cells(1, sLastCol).Address(False, False), "1", "")
Columns(LastColtxt & ":" & LastColtxt).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range(LastColtxt & "1").Select
ActiveCell.FormulaR1C1 = "8/1/2014"
Range(LastColtxt & "2").Select
End If
End If

End Sub

 

[venkat1926]

your thinking may be right. but my thinking is different

suppose data is like this. I have added two more dates in the year 2015 ln sheet1. this is copied to sheet2 also, to preserve the orgiinal configuration

Sheet1

*	A	B
1	DATE	DATA
2	1/1/2014	1
3	1/7/2014	2
4	3/7/2014	3
5	3/9/2014	4
6	4/7/2014	5
7	5/7/2014	6
8	6/7/2014	7
9	6/2/2014	8
10	1/1/2015	9
11	6/5/2015	10

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4


now there are three macros. but run only "fina_macro"

[CODE]Sub mmonth()
Dim r As Range, c As Range
Set r = Range(Range("a2"), Range("A2").End(xlDown))
For Each c In r
Cells(c.Row, "C") = Month(CDate(c))
Next c
Range("C1") = "month_number"
End Sub

[/CODE]

Sub testone()
Dim r As Range, rmonth As Range, c As Range
Set r = Range(Range("C2"), Range("C2").End(xlDown))
For Each c In r
'c.Offset(0, 1) = "=AverageIfs(" & r.Offset(0, -1).Address & ", " & r.Address & ", " & c & ")"
c.Offset(0, 1) = "=AverageIfs(" & r.Offset(0, -1).Address & ", " & r.Address & ", " & c & ")"
        Next c
 Range("D1") = "monthly average"
End Sub

Sub final_macro()
Application.ScreenUpdating = False
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("a1")
Worksheets("sheet1").Activate
Range("c1:d1").EntireColumn.Delete
mmonth
testone
Range("C1:D1").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "macro done see column D"
End Sub