Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro page breaks on column value not row 1 - use value in footer?
Hi, I have seen some posts that are similar, but no one seems to have the problem that I am having. I will post my macro in this, for anyone that is interested. My users get a csv file every month, and we have to clean it up. This macro does that. My last issues are this: 1) having the spreadsheet create page breaks whenever the value in column B changes. Below is just that code. Code: -------------------- col = 2 LastRw = ActiveSheet.UsedRange.Rows.Count For X = 2 To LastRw If Cells(X, col) < Cells(X - 1, col) And Cells(X, col) < Range("B1") Then ActiveWindow.SelectedSheets.HPageBreaks.Add Befo=Cells(X, col) End If Next -------------------- The problem that I am having, is that my first page is just row 1. I have row 1 repeat at the top of every page. It does make sense in the code that this value changes, so it makes a page break. Can anyone help me to adjust my code so that it will ignore the first row when it makes the page breaks? The value of B1 will always be the same, so my thought is to make that "If ...Then" statement include something that says not if Cells(X, col) = B1. Make sense? Second issue: 2) I want to take the value in column B, as it will be the same for any given page due to the above page breaks, and put that in the footer. I have commented out the code that I was having fun with trying. The idea is that column B is a box number, and I want to have that box number in the footer, so that it is easy to see on the sheet. Here is my page setup code for headers and footers. As I said, I commented out the right footer where I would put this code. Any help would be great. Code: -------------------- With ActiveSheet.PageSetup .CenterHeader = "Our Form" .LeftFooter = Date .CenterFooter = "Signature __________________________________" ' this is where I want the value -- .RightFooter = "Box Number: " & Column("B:B").Value End With -------------------- From the posts I have been reading, you cannot use formulas in the footer. I wish this was not true. My idea was that many formulas or functions could work here. Because I break the page on the value in this column any function that finds the value of any B column cell in the page could be used in this right footer. Like first or last would work. Anyway, if I cannot get this second part, I can still deploy the macro. I just need to fix the first part. For anyone who is interested, I will post my code in a reply. It is too long as one whole post. Thanks! ;) -- misscrf ------------------------------------------------------------------------ misscrf's Profile: http://www.excelforum.com/member.php...o&userid=14225 View this thread: http://www.excelforum.com/showthread...hreadid=473865 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro page breaks on column value not row 1 - use value in footer?
Here is my entire messy code. I started off with what we had, recorded portions to do more, and added bits and pieces together. Be warned that I am not advanced at Excel macros, so it is a messy one. It is not organized at all, but it works! Code: -------------------- Sub MyCsvConvert() Application.ScreenUpdating = False Columns("A:B").Select Selection.Delete Shift:=xlToLeft ActiveCell.FormulaR1C1 = "Date " & Chr(10) & "Entered" With ActiveCell.Characters(Start:=1, Length:=13).Font End With Range("A1").Select With Selection .HorizontalAlignment = xlCenter End With Columns("B:B").Select Selection.Delete Shift:=xlToLeft ActiveCell.FormulaR1C1 = "SKP " & Chr(10) & "Box #" Columns("B:B").Select Selection.ColumnWidth = 9.2 Range("B1").Select With Selection .HorizontalAlignment = xlRight End With Columns("C:G").Select Selection.Delete Shift:=xlToLeft ActiveCell.FormulaR1C1 = "Dept. #" Range("C1").Select With Selection .HorizontalAlignment = xlRight End With Columns("D:D").Select Selection.Delete Shift:=xlToLeft ActiveCell.FormulaR1C1 = "Record " & Chr(10) & "Code" With ActiveCell.Characters(Start:=1, Length:=12).Font End With Range("D1").Select With Selection .HorizontalAlignment = xlRight End With Columns("E:G").Select Selection.Delete Shift:=xlToLeft Columns("E:E").Select Selection.ColumnWidth = 9.17 Range("E1").Select With Selection .HorizontalAlignment = xlCenter End With ActiveCell.FormulaR1C1 = "Destruction " & Chr(10) & "Date" With ActiveCell.Characters(Start:=1, Length:=17).Font End With Range("F1").Select Columns("F:F").ColumnWidth = 9.5 Columns("F:G").Select With Selection .HorizontalAlignment = xlLeft End With Columns("H:I").Select Selection.Delete Shift:=xlToLeft Columns("H:H").Select Selection.ColumnWidth = 21.5 'Columns("I:I").ColumnWidth = 21.5 Columns("I:I").Select Selection.Delete Shift:=xlToLeft 'ActiveWindow.SmallScroll ToRight:=6 Columns("I:J").Select Selection.ColumnWidth = 21.5 'Columns("K:K").ColumnWidth = 21.5 Columns("K:M").Select Selection.Delete Shift:=xlToLeft ActiveWindow.LargeScroll ToRight:=-1 Range("C1").Select ActiveCell.FormulaR1C1 = "Depart #" Range("D1").Select ActiveCell.FormulaR1C1 = "Atty Number" Range("G1").Select ActiveCell.FormulaR1C1 = "Client Number" Range("F1").Select ActiveCell.FormulaR1C1 = "Matter Number" Range("H1").Select ActiveCell.FormulaR1C1 = "Client Name" Range("J1").Select ActiveCell.FormulaR1C1 = "Matter/File Descrip" Range("I1").Select ActiveCell.FormulaR1C1 = "Real/Est Collect Numer" Range("E1").Select ActiveCell.FormulaR1C1 = "Closing Date" Columns("I:I").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("H:H").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("J:J").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("H:H").ColumnWidth = 34.57 Rows("1:1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("F1").Select Columns("F:F").EntireColumn.AutoFit Columns("G:G").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit Columns("I:I").EntireColumn.AutoFit ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.View = xlPageBreakPreview ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 ActiveWindow.LargeScroll ToRight:=-1 Cells.Select Selection.Copy Workbooks.Add Template:="Workbook" ActiveSheet.Paste ActiveSheet.PageSetup.Orientation = xlLandscape With Worksheets(1).PageSetup .LeftMargin = Application.InchesToPoints(0.35) .RightMargin = Application.InchesToPoints(0.35) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) End With With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintGridlines = True ActiveWindow.View = xlNormalView With ActiveSheet.PageSetup .CenterHeader = "Our Form" .LeftFooter = Date .CenterFooter = "Signature __________________________________" ' this is where I want the value -- .RightFooter = "Box Number: " & Column("B:B").Value End With Columns("A:A").EntireColumn.AutoFit Columns("B:B").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit Columns("D:D").EntireColumn.AutoFit Columns("E:E").EntireColumn.AutoFit Columns("F:F").EntireColumn.AutoFit Columns("G:G").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit Columns("I:I").EntireColumn.AutoFit Columns("J:J").EntireColumn.AutoFit Columns("F:F").ColumnWidth = 9.29 Columns("F:F").ColumnWidth = 7 Columns("F:F").ColumnWidth = 6.29 Columns("F:F").ColumnWidth = 5.57 Columns("F:F").EntireColumn.AutoFit Columns("F:F").Select With Selection .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.ColumnWidth = 9.43 Selection.ColumnWidth = 7.71 Columns("G:G").Select With Selection .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.ColumnWidth = 9.43 Selection.ColumnWidth = 8 Selection.ColumnWidth = 7.29 Columns("I:I").Select With Selection .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.ColumnWidth = 15.57 Selection.ColumnWidth = 12.71 Selection.ColumnWidth = 11 Columns("J:J").ColumnWidth = 25.86 Columns("J:J").ColumnWidth = 28.29 Range("H2").Select ActiveCell.FormulaR1C1 = "M & T MORTGAGE CORPORATION" With ActiveCell.Characters(Start:=1, Length:=30).Font .Name = "Arial" .FontStyle = "Regular" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Cells.Replace What:="&", Replacement:="&", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Rows("1:1").Select Selection.Font.Bold = True Range("D1").Select Columns("D:D").ColumnWidth = 7.71 Columns("E:E").ColumnWidth = 7.43 Range("I1").Select With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False End With Columns("B:B").Select Range("A1:J81").sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal col = 2 LastRw = ActiveSheet.UsedRange.Rows.Count For X = 2 To LastRw If Cells(X, col) < Cells(X - 1, col) And Cells(X, col) < Range("B1") Then ActiveWindow.SelectedSheets.HPageBreaks.Add Befo=Cells(X, col) End If Next If Not ActiveWorkbook.Saved Then ThisWorkbook.Saved = True ThisWorkbook.Close End If End Sub -------------------- Thanks again! -- misscrf ------------------------------------------------------------------------ misscrf's Profile: http://www.excelforum.com/member.php...o&userid=14225 View this thread: http://www.excelforum.com/showthread...hreadid=473865 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Vertical page breaks - one per column | Excel Worksheet Functions | |||
blank row macro with page breaks | Excel Programming | |||
blank row macro with page breaks | Excel Programming | |||
blank row macro with page breaks | Excel Programming | |||
Macro to insert page breaks when values in 1 or more columns changes | Excel Programming |