Solved

VBA that will insert columns with formulas

Posted on 2014-10-02
10
108 Views
Last Modified: 2014-10-03
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
0
Comment
Question by:Jagwarman
  • 5
  • 4
10 Comments
 

Author Comment

by:Jagwarman
ID: 40357302
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
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 40357417
seems like a big project :-)
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 40357643
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Jagwarman
ID: 40358765
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
 
LVL 47

Expert Comment

by:Martin Liss
ID: 40359745
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
 
LVL 47

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 40359895
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
 

Author Comment

by:Jagwarman
ID: 40360026
Martin that is brilliant many many thanks. Have a great weekend.
0
 

Author Closing Comment

by:Jagwarman
ID: 40360028
This man is so good, Legend.
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 40360077
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
 

Author Comment

by:Jagwarman
ID: 40360156
I'll take a look thanks
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

679 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question