Macro enhancement needed

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
snyperjAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

snyperjAuthor Commented:
This screenshot is the desired end result
screen3.JPG
0
NorieVBA ExpertCommented:
Try this.
Columns(2).Insert xlShiftToLeft

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

ActiveSheet.PrintOut Copies:=1

Open in new window

0
snyperjAuthor Commented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

NorieVBA ExpertCommented:
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
snyperjAuthor Commented:
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
NorieVBA ExpertCommented:
Oops, my mistake, I didn't actually see the original attachment.
0
NorieVBA ExpertCommented:
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
snyperjAuthor Commented:
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
NorieVBA ExpertCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
snyperjAuthor Commented:
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
snyperjAuthor Commented:
close enough, I guess
0
NorieVBA ExpertCommented:
Is the problem that the code doesn't take the no of rows into account?
0
snyperjAuthor Commented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.