Solved

Macro enhancement needed

Posted on 2012-03-17
13
185 Views
Last Modified: 2012-03-27
I use the following macro to add some fomatting to my worksheet.  I got this from another memeber of EE.  It adds subtotals and makes the subtotal line grey shaded... it works great, but I am wondering if it is possible to take it even one step further.

I am not too great at explaing the code, but I will tell you what it does.
Subtotaling by column B, it adds summary totals to columns D,E.F

Now, what I am looking to do is to keep all of that intact, but as part of the macro, hide columns A & B so that the workbook can be printed.

However, I think the real problem is that I lose the subtotal line that appears under column B.  So I was wondering if there was a way to move that value over 1 cell?

The screenshot shows after the macro has run.  So the additional feature I would like to add would be to hide columns A & B and move the "Dept 1 Total" , 'Dept A Total" over 1 column (under Sales Name, but keeping the Sales Group value.)





Code:

Sub subTotalAndGroup()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim r As Range

    vflag = 1
   
    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
   
        If ActiveSheet.AutoFilterMode = True Then
          ActiveSheet.AutoFilterMode = False
        End If


    Set rng = wks.Range("A4", wks.Range("F" & wks.Rows.Count).End(xlUp))
    rng.subTotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4, 5, 6), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
       
    For Each r In wks.Range("B5", wks.Range("B" & wks.Rows.Count).End(xlUp))
        If InStr(r.Value, "Total") <> 0 Then
            r.Offset(, 2).Font.Bold = True
            r.Offset(, 3).Font.Bold = True
            r.Offset(, 4).Font.Bold = True
            If r.Value <> "Grand Total" Then
                wks.Range("A" & r.Row & ":G" & r.Row).Interior.Color = 12632256 'make subtotal line grey
            End If
        End If
    Next r

Range("A5").Select
SCREEN2.JPG
0
Comment
Question by:snyperj
  • 7
  • 6
13 Comments
 

Author Comment

by:snyperj
ID: 37732916
This screenshot is the desired end result
screen3.JPG
0
 
LVL 33

Expert Comment

by:Norie
ID: 37732928
Try this.
Columns(2).Insert xlShiftToLeft

Columns(1).Resize(,2).Hidden = 2

ActiveSheet.PrintOut Copies:=1

Open in new window

0
 

Author Comment

by:snyperj
ID: 37732944
Close, that hides columns A & B, but it essentially shifts all of the contents of column B into C (so column B is empty and hidden..)   I am hoping to only shift the subtotal line value in column b to column c  

Thanks.
0
 
LVL 33

Expert Comment

by:Norie
ID: 37732968
Can I just clarify?

You want to hide A & B but move the values in the 'subtotal' line to C?

What about the other values in the same rows as the subtotals?
0
 

Author Comment

by:snyperj
ID: 37733025
I just want to move the subtotal line value that appears in column b to column c...because column b is going to be hidden.  Please see screen3.jpg above.  The values 'Dept 1 Total', 'Dept A Total' and 'Dept B Total' are the only ones that were shifted (manually in the example) one column over from where they were.  

I just don't want to lose being able to see the label of what the subtotal grouping is...
0
 
LVL 33

Expert Comment

by:Norie
ID: 37733028
Oops, my mistake, I didn't actually see the original attachment.
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 33

Expert Comment

by:Norie
ID: 37733084
OK, try this.
    With Range("C1:C22").SpecialCells(xlCellTypeBlanks)
        .Formula = "=IF(B7<>"""", B7, """")"

    End With
    
    Columns(1).Resize(, 2).Hidden = True

Open in new window


Or if you don't want  Grand Total  copied over
    With Range("C1:C20").SpecialCells(xlCellTypeBlanks)
        .Formula = "=IF(B7<>"""", B7, """")"

    End With
    
    Columns(1).Resize(, 2).Hidden = True

Open in new window

0
 

Author Comment

by:snyperj
ID: 37733708
Nice job is does what I want it to do, but the only problem is the number of rows might vary.  It could be 22, or it could be 122.  The code seems to be hard coded to 22.  Can that be changed?   THANKS for your help!!
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 37733846
Try this.
 LastRow = Range("C" & Rows.Count).End(xlUp).Row

    With Range("C1:C" & LastRow).SpecialCells(xlCellTypeBlanks)
        .Formula = "=IF(B7<>"""", B7, """")"

    End With
    
    Columns(1).Resize(, 2).Hidden = True

Open in new window

0
 

Author Comment

by:snyperj
ID: 37742570
Very close here...thank you.  I made an error on the manual version in the screenshot above.  I also need to see the group name for the LAST group.  Is that possible?  

So in other words, in the screenshot there line that has the $400,000, $446,655 and $46,655 should say in the first column "Dept C Total".

It is missing in my screenshot example, but it also does not do it in the macro either.

Thanks!
0
 

Author Comment

by:snyperj
ID: 37773551
close enough, I guess
0
 
LVL 33

Expert Comment

by:Norie
ID: 37773569
Is the problem that the code doesn't take the no of rows into account?
0
 

Author Comment

by:snyperj
ID: 37774537
it's ok... I actually went with not hiding column B..and in the end it is fine.  font is smaller because more data needs to display... but it's all good.  Thanks for your help on this,
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Outlook Free & Paid Tools
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

762 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

18 Experts available now in Live!

Get 1:1 Help Now