State Page Number of Department Total

tlc53

Active Member
Joined
Jul 26, 2018
Messages
399
Hi there,

I'm not sure the best way to go about this.
I have totals on one sheet and the breakdown is on another sheet.
Next to the totals, I want to state which pages they should refer to for a breakdown of that figure.

Sheet: SkyCity Invoice
A21:A120 Contains Department Name

Sheet: SkyCity Breakdown
Column C has Department total.

eg. Sheet: SkyCity Invoice, Cell A21 contains department name: Action Prem, 1905
If this department name is located in Column C on "SkyCity Breakdown" state page number it is located on.

This will then give me the "to page number" and I can work out the from page number, based on the previous to.

Am I on the right track and is this sounding possible?

Thanks!
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hi, Please share complete information and if possible share the sheet data using XL2BB.

Which column in SkyCity Breakdown contains Department Name ?
What do you mean by "page number"
 
Upvote 0
Hi, Please share complete information and if possible share the sheet data using XL2BB.

Which column in SkyCity Breakdown contains Department Name ?
What do you mean by "page number"
Hi, I've managed to make some progress.

I've created a formula on my "SkyCity Invoice" sheet, to return the value in column A (where the page number is), if the criteria is met.

=VLOOKUP(A21,IF({1,0},'SkyCity Breakdown'!C:C,'SkyCity Breakdown'!A:A),2,0)

I now have a VBA code which displays the page number in a cell, when the code is run..

VBA Code:
Sub pagenumber()
'updateby Extendoffice 20160506
    Dim xVPC As Integer
    Dim xHPC As Integer
    Dim xVPB As VPageBreak
    Dim xHPB As HPageBreak
    Dim xNumPage As Integer
    xHPC = 1
    xVPC = 1
    If ActiveSheet.PageSetup.Order = xlDownThenOver Then
        xHPC = ActiveSheet.HPageBreaks.Count + 1
    Else
        xVPC = ActiveSheet.VPageBreaks.Count + 1
    End If
    xNumPage = 1
    For Each xVPB In ActiveSheet.VPageBreaks
        If xVPB.Location.Column > ActiveCell.Column Then Exit For
        xNumPage = xNumPage + xHPC
    Next
    For Each xHPB In ActiveSheet.HPageBreaks
        If xHPB.Location.Row > ActiveCell.Row Then Exit For
        xNumPage = xNumPage + xVPC
    Next
    ActiveCell = "" & xNumPage
    Selection.Font.Color = RGB(217, 217, 217)
End Sub

However, I don't want to run the above manually, I need it to automatically appear in column A where the totals are located, in this VBA..

VBA Code:
Sub ClientNarrative()

    Range("A3").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Sheets("Invoice Data").Columns("A:K").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("K20:K120"), CopyToRange:=Range("A3:K3"), Unique:= _
        False
            Range("A1").Select

If Range("A4") = 0 Then Exit Sub

Application.ScreenUpdating = False
Dim r As Range
Dim cust As Range

Set r = Range("A3:K" & Range("A" & Rows.Count).End(xlUp).Row)
Set cust = Sheets("SkyCity Invoice").Range("K20:K120")


cust.Offset(, 1).Value = Application.Transpose(Array(1, 2, 3, 4, 5, 6))
r.Columns(11).Offset(1, 1).Resize(r.Rows.Count - 1).FormulaR1C1 = "=VLOOKUP(RC[-1],R20C11:R25C12,2,0)"
r.Value = r.Value
Set r = r.Resize(r.Rows.Count, r.Columns.Count + 1)
r.Sort Key1:=[L52], Order1:=xlAscending, Header:=xlYes
r.Columns(12).ClearContents
cust.Offset(, 1).Value = vbNullString
Application.ScreenUpdating = True


Range("A4").Select


    Selection.CurrentRegion.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
        End With
       
        Dim sSortOrder As String

sSortOrder = Join(Filter(Application.Transpose(Sheets("SkyCity Invoice").Range("K20:K120").Value), "Blank", False), ",")
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add2 Key:=Selection.Columns(Selection.Columns.Count), Order:=xlAscending, CustomOrder:="""" & sSortOrder & """"
With ActiveSheet.Sort
  .SetRange Selection
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
End With
    Selection.Subtotal GroupBy:=11, Function:=xlSum, TotalList:=Array(6, 7, 9) _
        , Replace:=False, PageBreaks:=True, SummaryBelowData:=True


  Application.ScreenUpdating = False
  ActiveSheet.Outline.ShowLevels RowLevels:=2
  With Range("K" & Rows.Count).End(xlUp).CurrentRegion
    With .Offset(1).Resize(.Rows.Count - 1, 10).SpecialCells(xlVisible).Rows
      .Font.Bold = True
      .Interior.Color = 14277081
      .BorderAround xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    With Intersect(.Columns(3), .SpecialCells(xlVisible), .SpecialCells(xlBlanks))
      .FormulaR1C1 = "=IF(RC[8]=""Grand Total"",RC[8],INDEX(Category1,MATCH(LEFT(RC[8],LEN(RC[8])-6)+0,Criteria1,0),1))"
    End With
  End With
  ActiveSheet.Outline.ShowLevels RowLevels:=3
  Application.ScreenUpdating = True


            Range("A1").Select
    End Sub

I'm not sure how to piece these two together. Any idea please?
 
Upvote 0
Hi,
I'm still struggling with this one. I tried asking it to call pagenumber (see end of code below) but all that did was turn all my text grey o_O
I'm trying to get it to put the page number in column A at the same time it puts all my other totals in.
Can anyone suggest what to do please?

VBA Code:
Sub ClientNarrative()

    Range("A3").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Sheets("Invoice Data").Columns("A:K").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("K20:K120"), CopyToRange:=Range("A3:K3"), Unique:= _
        False
            Range("A1").Select

If Range("A4") = 0 Then Exit Sub

Application.ScreenUpdating = False
Dim r As Range
Dim cust As Range

Set r = Range("A3:K" & Range("A" & Rows.Count).End(xlUp).Row)
Set cust = Sheets("SkyCity Invoice").Range("K20:K120")


cust.Offset(, 1).Value = Application.Transpose(Array(1, 2, 3, 4, 5, 6))
r.Columns(11).Offset(1, 1).Resize(r.Rows.Count - 1).FormulaR1C1 = "=VLOOKUP(RC[-1],R20C11:R25C12,2,0)"
r.Value = r.Value
Set r = r.Resize(r.Rows.Count, r.Columns.Count + 1)
r.Sort Key1:=[L52], Order1:=xlAscending, Header:=xlYes
r.Columns(12).ClearContents
cust.Offset(, 1).Value = vbNullString
Application.ScreenUpdating = True


Range("A4").Select


    Selection.CurrentRegion.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
        End With
      
        Dim sSortOrder As String

sSortOrder = Join(Filter(Application.Transpose(Sheets("SkyCity Invoice").Range("K20:K120").Value), "Blank", False), ",")
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add2 Key:=Selection.Columns(Selection.Columns.Count), Order:=xlAscending, CustomOrder:="""" & sSortOrder & """"
With ActiveSheet.Sort
  .SetRange Selection
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
End With
    Selection.Subtotal GroupBy:=11, Function:=xlSum, TotalList:=Array(6, 7, 9) _
        , Replace:=False, PageBreaks:=True, SummaryBelowData:=True


  Application.ScreenUpdating = False
  ActiveSheet.Outline.ShowLevels RowLevels:=2
  With Range("K" & Rows.Count).End(xlUp).CurrentRegion
    With .Offset(1).Resize(.Rows.Count - 1, 10).SpecialCells(xlVisible).Rows
      .Font.Bold = True
      .Interior.Color = 14277081
      .BorderAround xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    With Intersect(.Columns(3), .SpecialCells(xlVisible), .SpecialCells(xlBlanks))
      .FormulaR1C1 = "=IF(RC[8]=""Grand Total"",RC[8],INDEX(Category1,MATCH(LEFT(RC[8],LEN(RC[8])-6)+0,Criteria1,0),1))"
    End With
With Intersect(.Columns(1), .SpecialCells(xlVisible), .SpecialCells(xlBlanks))
      Call pagenumber
    End With
  End With
  ActiveSheet.Outline.ShowLevels RowLevels:=3
  Application.ScreenUpdating = True


            Range("A1").Select
    End Sub
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top