State Page Number of Department Total

[tlc53]

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!

 

[Saurabhj]

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"

 

[tlc53]

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

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

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?

 

[tlc53]

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

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

 

[tlc53]

.