Solved

Macro enhancement needed

Posted on 2012-03-17
13
190 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 6
13 Comments
 

Author Comment

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

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
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!

 
LVL 34

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 34

Expert Comment

by:Norie
ID: 37733028
Oops, my mistake, I didn't actually see the original attachment.
0
 
LVL 34

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 34

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 34

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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
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.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

738 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