Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #108831 > unrolled thread

Need to get a Page Number for a Cell

Back to article view | Back to microsoft.public.excel.programming

Contents

  Need to get a Page Number for a Cell Chris Scott <christopherwscott76@gmail.com> - 2016-05-11 08:36 -0700
    Re: Need to get a Page Number for a Cell "Auric__" <not.my.real@email.address> - 2016-05-11 16:43 +0000
      Re: Need to get a Page Number for a Cell Chris Scott <christopherwscott76@gmail.com> - 2016-05-11 10:26 -0700
        Re: Need to get a Page Number for a Cell Claus Busch <claus_busch@t-online.de> - 2016-05-11 20:05 +0200

#108831 — Need to get a Page Number for a Cell

I have a large worksheet that I had been merging cells based if they contain the same information.  The problem is, the document could be super long and I am printing it to pdf.  So if there are multiple cells in a row vertically that are the same, you might not see that text on one page.  I am wanting to be able to tell if the rows are on the same page before merging them.  Is this possible?

[toc] | [next] | [standalone]

#108832

Chris Scott wrote:

> I have a large worksheet that I had been merging cells based if they
> contain the same information.  The problem is, the document could be
> super long and I am printing it to pdf.  So if there are multiple cells
> in a row vertically that are the same, you might not see that text on
> one page.  I am wanting to be able to tell if the rows are on the same
> page before merging them.  Is this possible?

Finding the page number *should* be irrelevant if you're merging content. (I 
don't *think* you can retrieve the info you want, but I'm not an expert.)

Without knowing exactly what you're doing, it's a bit hard to say, but 
here's what I use to find duplicates. Modify as needed.

  'compare selected cell to all below
  For L0 = ActiveCell.Row + 1 To _
           ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    If Cells(L0, ActiveCell.Column).Value = ActiveCell.Value Then
      [your option here: select found entry, mark it somehow (bold?),
       delete it, merge via code, whatever]
    End If
  Next

Select a cell and then run it.

You could further automate this by adding a second loop to step down the 
list, like this:

  'compare each cell in column to all below
  For L0 = ActiveCell.Row to _
           ActiveCell.SpecialCells(xlCellTypeLastCell).Row - 1
    For L1 = L0 + 1 to ActiveCell.SpecialCells(xlCellTypeLastCell).Row
      If Cells(L1, ActiveCell.Column).Value = _
         Cells(L0, ActiveCell.Column).Value Then
        [your option here, as above]
      End If
    Next
  Next

-- 
Do you recognize my face? I'm the one you left behind!

[toc] | [prev] | [next] | [standalone]

#108833

I think I have found what I need to do.  I need to determine when each page break is on the sheet.  Then go from there.

[toc] | [prev] | [next] | [standalone]

#108834

Hi Chris,

Am Wed, 11 May 2016 10:26:01 -0700 (PDT) schrieb Chris Scott:

> I think I have found what I need to do.  I need to determine when each page break is on the sheet.  Then go from there.

try:

Sub PageNumber()
Dim varPN() As Variant
Dim rngC As Range
Dim HPB As HPageBreak
Dim i As Long, j As Long, LRow As Long, First As Long, Last As Long
Dim wsh As Worksheet

Application.DisplayAlerts = False
'Modify sheet name
Set wsh = ThisWorkbook.Sheets("Sheet1")
With wsh
     LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
     'Modify PrintArea
     .PageSetup.PrintArea = "A1:G" & LRow
     
    For Each HPB In .HPageBreaks
        ReDim Preserve varPN(i)
        varPN(i) = HPB.Location.Row
        i = i + 1
    Next
    'Change i to 3 if you have headers
    For i = 2 To LRow
        First = 0: Last = 0
        If .Cells(i, 1) = .Cells(i - 1, 1) Then First = i - 1
        If First > 0 Then Last = Application.CountIf(.Range("A:A"), .Cells(i, 1)) + First - 1
        If First > 0 And Last > 0 Then
            For j = LBound(varPN) To UBound(varPN)
                If First < varPN(j) And Last <= varPN(j) Then
                    .Range(.Cells(First, 1), .Cells(Last, 1)).Merge
                    i = Last + 2
                    Exit For
                ElseIf First < varPN(j) And Last > varPN(j) Then
                    .Range(.Cells(First, 1), .Cells(varPN(j) - 1, 1)).Merge
                    i = varPN(j)
                    Exit For
                End If
            Next
        End If
    Next
End With
Application.DisplayAlerts = True
End Sub


Regards
Claus B.
-- 
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web