• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 195
  • Last Modified:

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
0
snyperj
Asked:
snyperj
  • 7
  • 6
1 Solution
 
snyperjAuthor Commented:
This screenshot is the desired end result
screen3.JPG
0
 
NorieCommented:
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

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

Featured Post

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now