Solved

VBA Code

Posted on 2011-03-07
6
194 Views
Last Modified: 2012-06-27
Hi,

I have a spreadsheet where i would like

(1) Read colF, when ever a number is not identical to the onle above it, add two rows and sum the columns for a subtotal. Bold the Subtotal

(2) Sum the columns of E as well

I have attached the raw data file (example) and a file which is where i want to be afterwards with the subtotals (example2), does anyone know any code that could do this?

Thanks
Seamus
Example.xls
Example2.xls
0
Comment
Question by:Seamus2626
  • 3
  • 2
6 Comments
 
LVL 19

Assisted Solution

by:akoster
akoster earned 150 total points
Comment Utility
Seamus,

when you record the steps you make when going from example.xls to example2.xls, you will be presented with a rough macro that performs the trick.
Later on, you could clean up the code.

eg: the recorded code for including subtotals
Sub insert_subtotals()
'
' insert_subtotals Macro
'

'
    Columns("A:F").Select
    Range("F1").Activate
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Open in new window


can be rewritten to
Sub insert_subtotals()
    Columns("A:F").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Open in new window


In order to add additional rows append some code, leading to :

Sub insert_subtotals()

    '-- add sub totals
    Columns("A:F").Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(6), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    '-- add spacers
    For Each Row In UsedRange.Columns("A:F").Rows
        If Left(Row.Cells(5), 3) = "Tot" Then
            Rows(Row.Row + 1).Insert shift:=xlShiftDown
        End If
    Next Row
    
End Sub

Open in new window

0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 350 total points
Comment Utility
Try this

Sub Sample()
    Dim TotColumns()
    Dim I As Long, LastRow As Long
    
    FinalCol = Sheets("Details").Range("A1").End(xlToRight).Column
    
    Application.ScreenUpdating = False
    
    ReDim Preserve TotColumns(1 To FinalCol - 2)
    For I = 3 To FinalCol
        TotColumns(I - 2) = I
    Next I
    
    With Sheets("Details")
        .Range("A1").Subtotal GroupBy:=6, Function:=xlSum, TotalList:=TotColumns, _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
    
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
    
        For I = LastRow To 1 Step -1
            If InStr(1, .Range("B" & I).Value, "Total", vbTextCompare) Then
                .Range("F" & I).Font.Bold = True
                .Range("F" & I).Value = Format(Range("F" & I).Value, "#,##0.00000000") & " Total"
                .Range("C" & I).Copy Range("B" & I)
                
                .Rows(I + 1).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next I
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window


Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Sorry akoster. Didn't see your post.

Sid
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Closing Comment

by:Seamus2626
Comment Utility
Thanks guys, i was playing with your code Akoster, but Sids slotted straight in, hence the uneven split.

Thanks again guys
Seamus
0
 
LVL 19

Expert Comment

by:akoster
Comment Utility
Sid,

no problem, it happens to everyone once in a while...
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Thanks. I had refreshed the page and then I started working on the file, testing each line of the code to ensure it worked exactly as the OP wanted and maybe that is the reason why there was a gap.

Sid
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

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 tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

744 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

16 Experts available now in Live!

Get 1:1 Help Now