Okay, looking at the result of Marc's code tells me that my above formula was wrong. That we need to keep increasing the column letters until we reach the next (printed) page.
Assuming that at least one cell has some value in the column that you want to insert the 1/A fractions into (or a column to the right of it, the following code will:
- Ask you to select the print range. (If you already selected it before with this code and/or did so with the print menu, just press the [Esc] key to continue . . . keep the previous print range.)
- Insert formulas or values in three helper columns. These helper column letters to be filled will be those which are outside of your used range. For example, if the last column you have ever typed anything into is column K, the first helper column to be filled is column L. (And then the other two will be columns M and N.)
- Clear the entire column where you previously put the #/columnLetter fractions (1/A) starting from the first cell where it needs to be placed (which you . . . at the moment, I can change it if you want . . . manually type into the beginning of the code in place of where I currently have "B7") and ending in the very last used cell in that row. So if you choose to put the 1/A fractions in column B, and your print range goes only to row 1000, but you have data in cell B1001, the content in cell B1001 will also be cleared.
- Fill it.
- Remove @ symbols in that column (that Excel is mysteriously putting in, causing a #Value error!)
- Convert the formulas in that column to values only.
- Clear the contents that was placed into the three helper columns such that the number of used columns (your horizontal scroll scope range) will remain the same.
- (If you want to see the formulas that this code puts into the helper columns, uncomment Line #1 and Line #2 at the end.
VBA Code:
Option Explicit
Sub Place_Fractions_On_Visible_Rows_To_Print()
'Assumes that the 1/A fractions are placed starting at row 2 or greater!!!
Dim printRange As String
Dim totalVisibleRowsToBePrintedSoFar As Integer
Dim firstRowOnNextPrintedPage As Long
Dim numOfVisRowsOnCurrentPrintedPage As Integer
Dim currentPageBreakRowNumber As Long
Dim topCellToPlaceFractions As String
Dim lastUsedColumnNumber As Integer
Dim firstRow As Long
Dim lastRow As Long
Dim lastusedRowInSheet As Long
Dim visibleRowIndicator_ColumnLetter As String
Dim numberOfPrintedRowsPerPage_ColumnLetter As String
Dim letterNumberOnCurrentPrintedPage_ColumnLetter As String
Dim columnToPut_Fractions_ColumnLetter As String
'___________________________________
'Input
topCellToPlaceFractions = "B7"
'___________________________________
firstRow = Range(topCellToPlaceFractions).Row
printRange = RangeSelectionPrompt("Select Print Range (Pres [Esc] to keep previous)")
With ActiveSheet
If printRange <> "" Then
.PageSetup.PrintArea = printRange
Else
printRange = .PageSetup.PrintArea
End If
lastRow = Range(printRange).Rows.Count + firstRow - 1
'Place the helper columns in the columns to the RIGHT of the right-most used column of the data.
lastUsedColumnNumber = .UsedRange.Columns.Count + .UsedRange.Column - 1 'The actual right-most column.
'****************************************************************
'Fill helper column that identifies rows with a row height >= 10.
'****************************************************************
lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
visibleRowIndicator_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)
'=IF(@RowHeight(A7)>=10,H6+1,H6)
.Range(visibleRowIndicator_ColumnLetter & firstRow & ":" & visibleRowIndicator_ColumnLetter & lastRow).Formula = _
"=IF(RowHeight(M7)>=10," & visibleRowIndicator_ColumnLetter & firstRow - 1 & "+1," & visibleRowIndicator_ColumnLetter & firstRow - 1 & ")"
'*******************************************************************************************************
'Fill helper column that marks the VISIBLE row that is the last row on the current (to be) printed page.
'*******************************************************************************************************
lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
numberOfPrintedRowsPerPage_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)
totalVisibleRowsToBePrintedSoFar = 0
For currentPageBreakRowNumber = 1 To .HPageBreaks.Count
firstRowOnNextPrintedPage = .HPageBreaks(currentPageBreakRowNumber).Location.Row
numOfVisRowsOnCurrentPrintedPage = Range(visibleRowIndicator_ColumnLetter & firstRowOnNextPrintedPage - 1).Value - totalVisibleRowsToBePrintedSoFar
.Range(numberOfPrintedRowsPerPage_ColumnLetter & firstRowOnNextPrintedPage - 1).Value = numOfVisRowsOnCurrentPrintedPage
totalVisibleRowsToBePrintedSoFar = totalVisibleRowsToBePrintedSoFar + numOfVisRowsOnCurrentPrintedPage
Next
'*****************************************************************************************
'Fill helper column that signifies the "increment" of the Column Letters in the fractions.
'*****************************************************************************************
lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
letterNumberOnCurrentPrintedPage_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)
'=IF(I7<>"",J6+1,H7-SUM($I$7:I7))
.Range(letterNumberOnCurrentPrintedPage_ColumnLetter & firstRow & ":" & letterNumberOnCurrentPrintedPage_ColumnLetter & lastRow).Formula = _
"=IF(" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow & "<>" & Chr(34) & Chr(34) & _
"," & letterNumberOnCurrentPrintedPage_ColumnLetter & firstRow - 1 & "+1," & visibleRowIndicator_ColumnLetter _
& firstRow & "-SUM($" & numberOfPrintedRowsPerPage_ColumnLetter & "$" & firstRow & ":" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow & "))"
'*********************************************************************
'Fill the column specified by user with the #/column letter fractions.
'*********************************************************************
lastusedRowInSheet = .UsedRange.Rows.Count + .UsedRange.Row - 1
columnToPut_Fractions_ColumnLetter = Split(Cells(1, Range(topCellToPlaceFractions).Column).Address, "$")(1)
'Clear previous contents in the column of focus (even beneath the print range if the print range doesn't go all the way to the end).
.Range(columnToPut_Fractions_ColumnLetter & firstRow & ":" & columnToPut_Fractions_ColumnLetter & lastusedRowInSheet).Formula = ""
With .Range(columnToPut_Fractions_ColumnLetter & firstRow & ":" & columnToPut_Fractions_ColumnLetter & lastRow)
.Formula = ""
'=SUM(IF($I$6:I6<>"",1,0))+1&"/"&SUBSTITUTE(SUBSTITUTE(ADDRESS(1,J7),"$",""),"1","")
.Formula = _
"=SUM(IF(" & "$" & numberOfPrintedRowsPerPage_ColumnLetter & "$" & firstRow - 1 & ":" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow - 1 & "<>" _
& Chr(34) & Chr(34) & ",1,0))+1&" & Chr(34) & "/" & Chr(34) & "&SUBSTITUTE(SUBSTITUTE(ADDRESS(1," & letterNumberOnCurrentPrintedPage_ColumnLetter _
& firstRow & ")," & Chr(34) & "$" & Chr(34) & "," & Chr(34) & Chr(34) & ")," & Chr(34) & "1" & Chr(34) & "," & Chr(34) & Chr(34) & ")"
.Replace What:="@", Replacement:="", LookAt:=xlPart, FormulaVersion:=xlReplaceFormula2
ActiveSheet.Calculate
.Formula = .Value 'Line #1
End With
'***********************************************
'Clear the formulas in all three helper columns.
'***********************************************
.Range(visibleRowIndicator_ColumnLetter & firstRow & ":" & letterNumberOnCurrentPrintedPage_ColumnLetter & lastRow).Value = "" 'Line #2
End With
End Sub
Function RowHeight(MR As Range) As Double
RowHeight = MR.RowHeight
End Function
Sub Test__RangeSelectionPrompt()
MsgBox RangeSelectionPrompt("Choose Cells")
End Sub
Function RangeSelectionPrompt(titleOfRangeSelectionPromptBox As String)
'Code is from http://www.vbaexpress.com/forum/showthread.php?763-Solved-Inputbox-Cell-Range-selection-Nothing-selected-or-Cancel&p=6680&viewfull=1#post6680
Dim Selectedarea As Range
On Error Resume Next
Set Selectedarea = Application.InputBox(prompt:="Left click on the top-left cell and drag to the botSomething-right cell.", _
Title:=titleOfRangeSelectionPromptBox, Default:=Selection.Address, Type:=8)
'If the user clicked on cancel,
If Selectedarea Is Nothing Then Exit Function
RangeSelectionPrompt = Selectedarea.Address
End Function
Maybe it's because you can get to the heart of the matter with precision? But I see a few regular contributers on here who prefer to use a single letter to name a variable. I actually remember doing that when I programmed my TI-84 plus graphing calculator.
Anyway, I was actually curious to see what my sub above would look like if I condensed it (I substituted the previously descriptive variable names with single letters and removed helpful comments). If I looked at this code in 6 months, I bet I would know
exactly what it does. (Just kidding . . . I don't know how you do it, but you're clearly better at this than I am!)
VBA Code:
Sub Demo1r2()
Dim A$, B%, C&, D%, E&, F$, G%, H&, I&, J&, K$, L$, M$, N$, O$, P$
F = "B7"
O = Chr(34)
P = O & O
H = Range(F).Row
A = RangeSelectionPrompt("Select Print Range (Pres [Esc] to keep previous)")
With ActiveSheet
If A <> "" Then
.PageSetup.PrintArea = A
Else
A = .PageSetup.PrintArea
End If
I = Range(A).Rows.Count + H - 1
G = .UsedRange.Columns.Count + .UsedRange.Column - 1
G = G + 1
K = Split(Cells(1, G).Address, "$")(1)
.Range(K & H & ":" & K & I).Formula = "=IF(RowHeight(A7)>=10," & K & H - 1 & "+1," & K & H - 1 & ")"
G = G + 1
L = Split(Cells(1, G).Address, "$")(1)
B = 0
For E = 1 To .HPageBreaks.Count
C = .HPageBreaks(E).Location.Row
D = Range(K & C - 1).Value - B
.Range(L & C - 1).Value = D
B = B + D
Next
G = G + 1
M = Split(Cells(1, G).Address, "$")(1)
.Range(M & H & ":" & M & I).Formula = "=IF(" & L & H & "<>" & P & "," & M & H - 1 & "+1," & K & H & "-SUM($" & L & "$" & H & ":" & L & H & "))"
J = .UsedRange.Rows.Count + .UsedRange.Row - 1
N = Split(Cells(1, Range(F).Column).Address, "$")(1)
.Range(N & H & ":" & N & J).Formula = ""
With .Range(N & H & ":" & N & I)
.Formula = ""
.Formula = _
"=SUM(IF(" & "$" & L & "$" & H - 1 & ":" & L & H - 1 & "<>" _
& P & ",1,0))+1&" & O & "/" & O & "&SUBSTITUTE(SUBSTITUTE(ADDRESS(1," & M _
& H & ")," & O & "$" & O & "," & P & ")," & O & "1" & O & "," & P & ")"
.Replace What:="@", Replacement:="", LookAt:=xlPart, FormulaVersion:=xlReplaceFormula2
ActiveSheet.Calculate
.Formula = .Value
End With
.Range(K & H & ":" & M & I).Value = ""
End With
End Sub
Gentlemen, what can I say. This is amazing. Thank you both cmowla and Marc, great to touch base with you again Marc. I had a chance this morning to run through what you both had posted and both work fantastically. Let me explain my process.
First, I ran cmowla's code from post #7, it ran fine, but didn't change the page numbering at the page breaks, but I could understand how you were using the helper column B.
Second, I ran Marc's code from Post #8, [Sub Demo1r()], this too ran fine, page numbering changed perfectly at the page breaks however, I noticed from letters 'O' through to 'Z', irrespective of the page number, the letters were suffixed with a '$' sign after it. I couldn't work out why. After (page number)/Z$ the next line was (page number)/AA which was perfect.
Third, I ran Marc's code from Post #9, [Sub Demo1r2d2()], this too ran perfectly, very quick, however, still had the $ sign appearing in same location as mentioned above.
Forth, I ran cmowla's code from post #10, 1st part. Thanks so much for explaining so clearly step by step what you were doing, this has helped me no end. The code ran fine but ended up in a continuous loop, I think trying to delete the helper columns but not too sure, I am an amateur at this as you can see.
Fifth, I ran cmowla's code from post #10, 2nd part only this time [Sub Demo1r2()]. I commented out this line:
A = RangeSelectionPrompt("Select Print Range (Pres [Esc] to keep previous)")
as I do already have a dynamic print range set up. It ran perfectly, took about 5 seconds to run over 900 rows. I added
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
at the beginning of the code, and then reversed it a the end of the code and it took less than 1 second. Amazing stuff.
I would be interested Marc to know how to remove the $ signs that appear on the end of letters 'O' through to 'Z' but you have already been so helpful, if you don't have time, no worries.
Thank you both once again for the time and effort you have both put in to solving my problem, it is greatly appreciated.
Kind regards
Adam
