Solved

VBA that will insert columns with formulas

Posted on 2014-10-02
10
101 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 25

Expert Comment

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

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
 

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 45

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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 45

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 45

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

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,…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

757 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now