How to Add New Month if date changes

sourabh_ajmera

New Member
Joined
Jul 17, 2014
Messages
36
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
Code:
    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
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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

*ABCD
1DATEDATAMONTH NUMBRAVG DATA
21/1/2014111.5
31/7/2014211.5
43/7/2014333.5
53/9/2014433.5
64/7/2014545
75/7/2014656
86/7/2014767.5
96/2/2014867.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
CellFormula
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

New Member
Joined
Jul 17, 2014
Messages
36
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
Code:
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
 
Last edited:

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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

New Member
Joined
Jul 17, 2014
Messages
36
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

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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

*AB
1DATEDATA
21/1/20141
31/7/20142
43/7/20143
53/9/20144
64/7/20145
75/7/20146
86/7/20147
96/2/20148
101/1/20159
116/5/201510

<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:
[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]

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

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,474
Messages
5,601,880
Members
414,479
Latest member
Beau the dog

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top