VBA that will insert columns with formulas

I have attached a spreadsheet that has two tabs [Example 1 and Example 2] Example 1 contains two months data Example 2 contains 3 months data.
In Column B there is the word Total and in their respective row are totals.

C5 is =SUM(C3:C4)
D5 is =SUM(D3:D4)
E5 is =SUM(E3:E4)
Etc etc

Under I-K are the totals of the totals:
I5 is =C5+F5
J5 is =D5+G5
K5 is =E5+H5
Etc etc

So this is where it gets tricky.

Example 2 shows 3 months data.

What I am trying to do, without success is each month 3 new columns will go into the right hand side after the previous month. So looking at Example 2 columns L-N will move to O-Q and 2014/ Apr data would go into L-N
When the new months are input I need all of the formula to auto-populate [preferably using VBA code because this is part of a bigger Macro]

This sounds like an impossible request but I know there is an expert out there that likes a challenge like this.

thanks in advance.
AddColumns.xlsx
JagwarmanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

JagwarmanAuthor Commented:
Having thought this through some more..........

What my macro needs to do is move the data across and put in the formulas as in Example 3 in the attached file, beause the user enters the numbers manually.

Thanks
AddColumns.xlsx
0
ProfessorJimJamCommented:
seems like a big project :-)
0
Martin LissOlder than dirtCommented:
Here's a macro that assumes that you've added the columns for the new month and you want to regenerate the 'Totals' formulas. I apologize for not having the time to fully test it, so make a copy of at least your sheet before you try it.

Sub GenerateFormulas()
Dim lngLastCol As Long
Dim lngCol As Long
Dim lngRow As Long
Dim lngTotalsCol As Long
Dim lngFormulaCol As Long
Dim strFormula As String

    With ActiveSheet.UsedRange
        lngLastCol = .Columns(.Columns.Count).Column
    End With
    
    ' Find the totals
    For lngCol = 1 To lngLastCol
        If Cells(1, lngCol).Value = "Total" Then
            lngTotalsCol = lngCol
            Exit For
        End If
    Next
    
    ' Generate the formulas (
    For lngFormulaCol = lngTotalsCol To lngTotalsCol + 2
        For lngRow = 3 To 47
            strFormula = "="
            For lngCol = 3 To lngTotalsCol - 1 Step 3
                If strFormula = "=" Then
                    strFormula = strFormula & Split(Cells(1, lngCol).Address, "$")(1) & lngRow
                Else
                    strFormula = strFormula & "+" & Split(Cells(1, lngCol).Address, "$")(1) & lngRow
                End If
            Next
            Cells(lngRow, lngFormulaCol).Formula = strFormula
        Next
    Next
End Sub

Open in new window

0
Build an E-Commerce Site with Angular 5

Learn how to build an E-Commerce site with Angular 5, a JavaScript framework used by developers to build web, desktop, and mobile applications.

JagwarmanAuthor Commented:
Hi Martin, thanks for that, it's kindof what I need except that what it appears to do is put the same formulas in each of the 3 cells. i.e. if I move mty totals to R,S and T the same formula [=C3+F3+I3+L3+O3] is in R3, S3 and T3

What I need is for R3 to have =C3+F3+I3+L3+O3  S3 to have =D3+G3+J3+M3+P3 and T3 to have E3+H3+K3+N3+Q3

Regards
0
Martin LissOlder than dirtCommented:
Try this modification. Would you also like me to add code that will insert the columns for the new month?

Sub GenerateFormulas()
Dim lngLastCol As Long
Dim lngCol As Long
Dim lngRow As Long
Dim lngTotalsCol As Long
Dim lngFormulaCol As Long
Dim strFormula As String

    With ActiveSheet.UsedRange
        lngLastCol = .Columns(.Columns.Count).Column
    End With
    
    ' Find the totals
    For lngCol = 1 To lngLastCol
        If Cells(1, lngCol).Value = "Total" Then
            lngTotalsCol = lngCol
            Exit For
        End If
    Next
    
    ' Generate the formulas
    For lngFormulaCol = lngTotalsCol To lngTotalsCol + 2
        For lngRow = 3 To 47
            strFormula = "="
            For lngCol = 3 To lngTotalsCol - 1 Step 3
                If strFormula = "=" Then
                    strFormula = strFormula & Split(Cells(1, lngCol + lngFormulaCol - lngTotalsCol).Address, "$")(1) & lngRow
                Else
                    strFormula = strFormula & "+" & Split(Cells(1, lngCol + lngFormulaCol - lngTotalsCol).Address, "$")(1) & lngRow
                End If
            Next
            Cells(lngRow, lngFormulaCol).Formula = strFormula
        Next
    Next
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
OK, in case you need it here's code that adds a new month (initialized) and updates the totals formulas.

Sub AddNewMonth()
Dim lngLastCol As Long
Dim lngCol As Long
Dim lngRow As Long
Dim lngTotalsCol As Long
Dim lngFormulaCol As Long
Dim strFormula As String

    With ActiveSheet.UsedRange
        lngLastCol = .Columns(.Columns.Count).Column
    End With
    
    ' Find the totals
    For lngCol = 1 To lngLastCol
        If Cells(1, lngCol).Value = "Total" Then
            lngTotalsCol = lngCol
            Exit For
        End If
    Next
    
    ' Add the columns for the new month
    With ActiveSheet
        ' This takes advantage of the fact that row 1 contains merged cells
        ' 3 columns wide to insert 3 blank columns
        .Columns(lngTotalsCol).Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ' This rather complicated line converts thecolumn number of several columns to letters
        ' and copies the previous month to the newly added columns.
        .Columns(Split(.Cells(1, lngTotalsCol - 3).Address, "$")(1) & ":" & Split(.Cells(1, lngTotalsCol - 1).Address, "$")(1)).Copy _
                    Destination:=.Columns(Split(.Cells(1, lngTotalsCol).Address, "$")(1))
        
        ' Remove the old data from the new columns
        .Range(Split(.Cells(1, lngTotalsCol).Address, "$")(1) & "3:" & Split(.Cells(1, lngTotalsCol + 2).Address, "$")(1) & "47") _
                    .SpecialCells(xlCellTypeConstants).ClearContents
        ' Increment the month
        .Cells(1, lngTotalsCol).Value = Format(DateAdd("m", 1, CDate(.Cells(1, lngTotalsCol).Value)), "yyyy/mmm")
        .Cells(1, lngTotalsCol).Value = Replace(.Cells(1, lngTotalsCol).Value, "-", "/")
    
        lngTotalsCol = lngTotalsCol + 3
        ' Generate the formulas
        For lngFormulaCol = lngTotalsCol To lngTotalsCol + 2
            For lngRow = 3 To 47
                strFormula = "="
                For lngCol = 3 To lngTotalsCol - 1 Step 3
                    If strFormula = "=" Then
                        strFormula = strFormula & Split(.Cells(1, lngCol + lngFormulaCol - lngTotalsCol).Address, "$")(1) & lngRow
                    Else
                        strFormula = strFormula & "+" & Split(.Cells(1, lngCol + lngFormulaCol - lngTotalsCol).Address, "$")(1) & lngRow
                    End If
                Next
                .Cells(lngRow, lngFormulaCol).Formula = strFormula
            Next
        Next
    End With

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JagwarmanAuthor Commented:
Martin that is brilliant many many thanks. Have a great weekend.
0
JagwarmanAuthor Commented:
This man is so good, Legend.
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0
JagwarmanAuthor Commented:
I'll take a look thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.