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?
 
NorieConnect With a Mentor VBA 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
 
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
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

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

All Courses

From novice to tech pro — start learning today.