Automatically enter month in a cell

[ipbr21054]

Morning,

I use the same worksheet template every month.
I would like to put a code etc in Cell B1 which would just enter the month.
So say starting in July the cell is blank.
I open the worksheet the code looks at the current month from pc etc and enters JULY into Cell B1

Next month i would use the same blank template where the above happens again but AUGUST is the entered into Cell B1


I tried this but it just returned an error.

=TEXT(B1, "mmm")

Thanks

 

[steve the fish]

If you want the month placed in a cell then something like:

=TEXT(TODAY(),"mmmm")

which will place todays month. It will change to whatever is todays month each time the workbook is opened.

 

[ipbr21054]

Thanks,
Thats works & enters the month fine.

Can it be written like worksheet initialize option.
so i can then format font size,position of text etc as when i run this code the existing format is overwritten.

Thanks

 

[steve the fish]

Yes it can. Which sheet? Which font? Which size? etc

 

[ipbr21054]

Hi,

Worksheet INCOME(1)
Font Calibri
Font Size 11
Middle align
Align text center
All borders

Sub date_and_year()

    Range("B1") = Format(date_month, "mmmm")
    
    Range("B2") = Format(date_year, "yyyy")
    
End Sub

 

[steve the fish]

Do you know how to use the macro recorder. Record your steps doing the formatting then return the result here.

 

[ipbr21054]

You must of read my mind.
The below code will apply for cell B1 which will be for mmmm and cell B2 which which will be for yyyy

Sub Macro1()'
' Macro1 Macro
'


'
    Range("B1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End Sub

 

[steve the fish]

Paste the following into standard module:

Sub AddMonth()

With Sheets("INCOME(1)")
    .Range("B1") = Format(Now, "mmmm")
    .Range("B2") = Year(Now)
    With .Range("B1:B2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Font
            .Name = "Calibri"
            .FontStyle = "Bold"
            .Size = 11
        End With
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
        End With
    End With
End With

End Sub

Right click on 'This Workbook' in the VBA window, View Code, paste this:

Private Sub Workbook_Open()

Call AddMonth

End Sub

Close and save the book as .xlsm. Open it back up and the macro should run. Or you can just run AddMonth as normal.

 

[ipbr21054]

Many thanks.

Just looking at it.
Can you addvise how i add the code to make it upper case.

Also please can we expand oN...... With Sheets("INCOME(1)") To also have it be applied to EXPENSES(1)

Thanks for your time & have a nice day

 

[steve the fish]

Sure change the macro to this:

Sub AddMonth()

Dim arr, i As Long

arr = Array("INCOME(1)", "EXPENSES(1)")
For i = LBound(arr) To UBound(arr)
    With Sheets(arr(i))
        .Range("B1") = UCase(Format(Now, "mmmm"))
        .Range("B2") = Year(Now)
        With .Range("B1:B2")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            With .Font
                .Name = "Calibri"
                .FontStyle = "Bold"
                .Size = 11
            End With
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent1
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With
        End With
    End With
Next

End Sub