insert columns with formatting and formulas

Hello Leopard,

>> updated Dec. 9/2022 (see below)

It took me a few tries but I figured it out.

You only need to make a couple of small changes. Your code only copies the "Stock" column; that is why the are no formulas in the "Arrived" and "Sales" columns. Here are the changes needed:

' changed these two lines
'        .Cells(2, Columns.Count).End(xlToLeft)(1, -3).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).Copy
'            .Cells(2, Columns.Count).End(xlToLeft)(1, 1).Offset(1).Resize(.[A2].CurrentRegion.Rows.Count, 1).PasteSpecial xlPasteFormulas

' to the following  (copy formulas one column at a time)

             ' "Arrived" column formulas
            .Cells(2, Columns.Count).End(xlToLeft)(1, -3).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).Copy
            .Cells(2, Columns.Count).End(xlToLeft)(1, 0).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).PasteSpecial Paste:=xlPasteFormulas
            .Cells(2, Columns.Count).End(xlToLeft)(1, 0).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).SpecialCells(xlCellTypeConstants, 23).ClearContents

             ' "Sales" column formulas
             .Cells(2, Columns.Count).End(xlToLeft)(1, -2).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).Copy
             .Cells(2, Columns.Count).End(xlToLeft)(1, 1).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).PasteSpecial xlPasteFormulas
             .Cells(2, Columns.Count).End(xlToLeft)(1, 1).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).SpecialCells(xlCellTypeConstants, 23).ClearContents

            ' "Stock" column formulas
            .Cells(2, Columns.Count).End(xlToLeft)(1, -1).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).Copy
            .Cells(2, Columns.Count).End(xlToLeft)(1, 2).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 1).PasteSpecial xlPasteFormulas

The xlPasteFormulas treats numbers as formulas. That is why after doing the pasting for "Arrived" and "Sales" there is the extra line of code to remove constants.

The modified file is attached. (I also corrected the circular reference in V37)

If this solves your problem then please mark my answer as selected.

Update: re-wrote macro (due to a sugestion from John)

New macro is "NewMonth_2" and is in Module2 (updated file attached)

Here is the new macro code:

Sub NewMonth_2()

' macro written by Doug Wilson for TeachExcel forum question, Dec. 2022
' this macro was written due to a suggestion by John_Ru
' this macro is a simpler version of Leopard's original

    Dim rng As Range
    Dim oldmth As String, mystr As String
    Dim oldm As Integer, newm As Integer
    Dim am

    am = [{"JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"}]
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    With Sheets(1)
        oldmth = (.Cells(1, Columns.Count).End(xlToLeft)(1, 1))
        oldm = Application.Match(oldmth, am, 0)
        newm = Month(DateSerial(Year(Now), oldm + 1, 1))

If .Cells(1, Columns.Count).End(xlToLeft)(1, 1).Value <> "JANUARY" Then

Dim LCol As Variant     ' last used column of sheet

LCol = Cells(2, Columns.Count).End(xlToLeft).Column

Columns(LCol).Select    ' select last month's 3 columns
    Selection.Copy
    .Columns(LCol + 1).Select   ' column to the right of last column
    Selection.Insert    ' inserts copied columns to the right
    Application.CutCopyMode = False     ' remove ~marching ants~ from around selection

' delete constants (numbers only, leave formulas) from "Arrived" and "Sales" columns
On Error Resume Next   ' this is needed in case there are no values (constants) in the column
.Cells(2, Columns.Count).End(xlToLeft)(1, 0).Offset(1, -1).Resize(.[A2].CurrentRegion.Rows.Count, 2).SpecialCells(xlCellTypeConstants, 23).ClearContents

End If

' insert new month at top of new columns
.Cells(1, Columns.Count).End(xlToLeft)(1, -2).Offset(, 1).Value = _
                        Choose(newm, "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER")

        With .Cells(1, Columns.Count).End(xlToLeft)(1, -2).Resize(, 3)
            .Merge
            .HorizontalAlignment = xlCenter
            .Font.ColorIndex = 1
            .Interior.ColorIndex = 6
             .Font.Size = 12
        End With

Cells(1, Columns.Count).End(xlToLeft).Select   ' cell at the top with the month name

' Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic

End With


End Sub

Cheers   :-)

Leopard

One way is to add a new variable and a simple loop at the end of your code to write the formula on any "TTL" row (changes in bold below):

Sub InsertMonth()
    Dim rng As Range
    Dim oldmth As String, mystr As String
    Dim oldm As Integer, newm As Integer
    Dim am
    Dim Rw As Long

<< Existing code>>

        End With

        ' loop down rows
        For Rw = 3 To .[A2].CurrentRegion.Rows.Count
            If .Cells(Rw, 2).Value = "TTL" Then
                ' if column 2=TTL then copy formula from last column to 2 before
                With .Cells(Rw, .[A2].CurrentRegion.Columns.Count)
                    .Copy
                    .Offset(0, -2).Resize(, 2).PasteSpecial xlPasteFormulas
                End With
            End If
        Next Rw

        .Cells(2, Columns.Count).End(xlToLeft)(1, 1).Offset(1).Select
        Application.CutCopyMode = False
        Application.Calculation = xlCalculationAutomatic
    End With
End Sub

Hope this fixes things for you.