# State Page Number of Department Total

#### tlc53

##### Active Member
Hi there,

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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

#### Saurabhj

##### Active Member
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

##### Active Member
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
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.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
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.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
.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

##### Active Member
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?

VBA Code:
Sub ClientNarrative()

Range("A3").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
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.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
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.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
.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

.

Last edited:

Replies
1
Views
65
Replies
1
Views
53
Replies
8
Views
333
Replies
8
Views
283
Replies
17
Views
314

1,127,820
Messages
5,627,092
Members
416,219
Latest member
TommyBoy79

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

### Which adblocker are you using?

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

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