Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
I recorded a macro and then made modifications to the code to do the
specific formatting that I want. I then created an icon that stays at the top of my spreadsheet which runs the macro on whatever spreadsheet that I open (Each spreadsheet always has the same format each time). The macro runs and formats the data correctly. However, I have two questions: 1) One problem is that the macro, in addition to working properly on the current spreadsheet, also creates the original spreadsheet that I recorded. I can't figure out how to just get it to format the current spreadsheet only. 2) Once I get this bug out, I am going to need to add this macro to other users spreadsheets in my department. How would I do this? Thanks. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
At the very least, ALWAYS post your macro for comments.
"If desired, send your file to dguillett @gmail.com I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results." |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
On Aug 5, 11:49*am, Don Guillett Excel MVP
wrote: At the very least, ALWAYS post your macro for comments. "If desired, send your file to dguillett I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results." I will also email the file to you, but here is the code to the macro. Sub FormatSUI() ' ' FormatSUI Macro ' Macro recorded 7/27/2010 by MarlieT ' ' Keyboard Shortcut: Ctrl+q ' Rows("1:2").Select Selection.Insert Shift:=xlDown Columns("A:R").Select Columns("A:R").EntireColumn.AutoFit ActiveWindow.SmallScroll ToRight:=-4 Range("D1").Select ActiveCell.FormulaR1C1 = "=R[2]C[-1]&"": ""&R[3]C[-1]" Range("E1").Select ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" Range("F1").Select ActiveCell.FormulaR1C1 = "=R[2]C[11]&"": ""&R[3]C[11]" Range("G1").Select ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" Range("D1:M1").Select Selection.Copy Range("D1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("D:D").EntireColumn.AutoFit Columns("D:D").ColumnWidth = 15.57 Columns("C:C").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("M:M").Select Selection.Delete Shift:=xlToLeft Columns("N:N").Select Selection.Delete Shift:=xlToLeft Selection.Delete Shift:=xlToLeft Selection.NumberFormat = "mm/dd/yy;@" Columns("E:I").Select Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" Columns("K:L").Select Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" Rows("3:3").Select Selection.Interior.ColorIndex = xlNone Selection.Font.Bold = True Range("C1:K1").Select Selection.Font.Bold = True Rows("4:4").Select ActiveWindow.FreezePanes = True Range("E3").Select Columns("G:L").Select Columns("G:L").EntireColumn.AutoFit Range("E3").Select Dim wks As Worksheet Dim LastCell As Range Set wks = ActiveSheet With wks Set LastCell = .Cells(.Rows.Count, "E").End(xlUp) End With LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" Columns("A:C").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A1").Select With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.75) .RightMargin = Application.InchesToPoints(0.75) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintErrors = xlPrintErrorsDisplayed End With With ActiveSheet.PageSetup .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .TopMargin = Application.InchesToPoints(0.25) .BottomMargin = Application.InchesToPoints(0.25) .HeaderMargin = Application.InchesToPoints(0.18) .FooterMargin = Application.InchesToPoints(0.18) .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 ' .PrintErrors = -14012 End With With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "Page &P of &N" .CenterFooter = "" .RightFooter = "&D" .LeftMargin = Application.InchesToPoints(0.33) .RightMargin = Application.InchesToPoints(0.29) .TopMargin = Application.InchesToPoints(0.34) .BottomMargin = Application.InchesToPoints(0.47) .HeaderMargin = Application.InchesToPoints(0.18) .FooterMargin = Application.InchesToPoints(0.23) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintErrors = xlPrintErrorsDisplayed End With ActiveWindow.SelectedSheets.PrintPreview End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
On Aug 5, 2:48*pm, tbmarlie wrote:
On Aug 5, 11:49*am, Don Guillett Excel MVP wrote: At the very least, ALWAYS post your macro for comments. "If desired, send your file to dguillett I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results." I will also email the file to you, but here is the code to the macro. Sub FormatSUI() ' ' FormatSUI Macro ' Macro recorded 7/27/2010 by MarlieT ' ' Keyboard Shortcut: Ctrl+q ' * * Rows("1:2").Select * * Selection.Insert Shift:=xlDown * * Columns("A:R").Select * * Columns("A:R").EntireColumn.AutoFit * * ActiveWindow.SmallScroll ToRight:=-4 * * Range("D1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[-1]&"": ""&R[3]C[-1]" * * Range("E1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("F1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[11]&"": ""&R[3]C[11]" * * Range("G1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("D1:M1").Select * * Selection.Copy * * Range("D1").Select * * Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ * * * * :=False, Transpose:=False * * Columns("D:D").EntireColumn.AutoFit * * Columns("D:D").ColumnWidth = 15.57 * * Columns("C:C").Select * * Application.CutCopyMode = False * * Selection.Delete Shift:=xlToLeft * * Columns("M:M").Select * * Selection.Delete Shift:=xlToLeft * * Columns("N:N").Select * * Selection.Delete Shift:=xlToLeft * * Selection.Delete Shift:=xlToLeft * * Selection.NumberFormat = "mm/dd/yy;@" * * Columns("E:I").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Columns("K:L").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Rows("3:3").Select * * Selection.Interior.ColorIndex = xlNone * * Selection.Font.Bold = True * * Range("C1:K1").Select * * Selection.Font.Bold = True * * Rows("4:4").Select * * ActiveWindow.FreezePanes = True * * Range("E3").Select * * Columns("G:L").Select * * Columns("G:L").EntireColumn.AutoFit * * Range("E3").Select * * *Dim wks As Worksheet * * *Dim LastCell As Range * * *Set wks = ActiveSheet * * *With wks * * * * *Set LastCell = .Cells(.Rows.Count, "E").End(xlUp) * * *End With * * *LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" * * *Columns("A:C").Select * * *With Selection * * * * .HorizontalAlignment = xlCenter * * * * .VerticalAlignment = xlBottom * * * * .Orientation = 0 * * * * .AddIndent = False * * * * .IndentLevel = 0 * * * * .ShrinkToFit = False * * * * .ReadingOrder = xlContext * * * * .MergeCells = False * * End With * * Range("A1").Select * * With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "" * * * * .CenterFooter = "" * * * * .RightFooter = "" * * * * .LeftMargin = Application.InchesToPoints(0.75) * * * * .RightMargin = Application.InchesToPoints(0.75) * * * * .TopMargin = Application.InchesToPoints(1) * * * * .BottomMargin = Application.InchesToPoints(1) * * * * .HeaderMargin = Application.InchesToPoints(0.5) * * * * .FooterMargin = Application.InchesToPoints(0.5) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * With ActiveSheet.PageSetup * * * * .LeftMargin = Application.InchesToPoints(0.25) * * * * .RightMargin = Application.InchesToPoints(0.25) * * * * .TopMargin = Application.InchesToPoints(0.25) * * * * .BottomMargin = Application.InchesToPoints(0.25) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.18) * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = 1 * * ' * *.PrintErrors = -14012 * * End With * * *With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "Page &P of &N" * * * * .CenterFooter = "" * * * * .RightFooter = "&D" * * * * .LeftMargin = Application.InchesToPoints(0.33) * * * * .RightMargin = Application.InchesToPoints(0.29) * * * * .TopMargin = Application.InchesToPoints(0.34) * * * * .BottomMargin = Application.InchesToPoints(0.47) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.23) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * ActiveWindow.SelectedSheets.PrintPreview End Sub I have not seen the file in my inbox. Send to dguillett@ gmail.com (remove the space in the email addy) |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
On Aug 5, 1:59*pm, Don Guillett Excel MVP
wrote: On Aug 5, 2:48*pm, tbmarlie wrote: On Aug 5, 11:49*am, Don Guillett Excel MVP wrote: At the very least, ALWAYS post your macro for comments. "If desired, send your file to dguillett I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results." I will also email the file to you, but here is the code to the macro. Sub FormatSUI() ' ' FormatSUI Macro ' Macro recorded 7/27/2010 by MarlieT ' ' Keyboard Shortcut: Ctrl+q ' * * Rows("1:2").Select * * Selection.Insert Shift:=xlDown * * Columns("A:R").Select * * Columns("A:R").EntireColumn.AutoFit * * ActiveWindow.SmallScroll ToRight:=-4 * * Range("D1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[-1]&"": ""&R[3]C[-1]" * * Range("E1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("F1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[11]&"": ""&R[3]C[11]" * * Range("G1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("D1:M1").Select * * Selection.Copy * * Range("D1").Select * * Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ * * * * :=False, Transpose:=False * * Columns("D:D").EntireColumn.AutoFit * * Columns("D:D").ColumnWidth = 15.57 * * Columns("C:C").Select * * Application.CutCopyMode = False * * Selection.Delete Shift:=xlToLeft * * Columns("M:M").Select * * Selection.Delete Shift:=xlToLeft * * Columns("N:N").Select * * Selection.Delete Shift:=xlToLeft * * Selection.Delete Shift:=xlToLeft * * Selection.NumberFormat = "mm/dd/yy;@" * * Columns("E:I").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Columns("K:L").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Rows("3:3").Select * * Selection.Interior.ColorIndex = xlNone * * Selection.Font.Bold = True * * Range("C1:K1").Select * * Selection.Font.Bold = True * * Rows("4:4").Select * * ActiveWindow.FreezePanes = True * * Range("E3").Select * * Columns("G:L").Select * * Columns("G:L").EntireColumn.AutoFit * * Range("E3").Select * * *Dim wks As Worksheet * * *Dim LastCell As Range * * *Set wks = ActiveSheet * * *With wks * * * * *Set LastCell = .Cells(.Rows.Count, "E").End(xlUp) * * *End With * * *LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" * * *Columns("A:C").Select * * *With Selection * * * * .HorizontalAlignment = xlCenter * * * * .VerticalAlignment = xlBottom * * * * .Orientation = 0 * * * * .AddIndent = False * * * * .IndentLevel = 0 * * * * .ShrinkToFit = False * * * * .ReadingOrder = xlContext * * * * .MergeCells = False * * End With * * Range("A1").Select * * With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "" * * * * .CenterFooter = "" * * * * .RightFooter = "" * * * * .LeftMargin = Application.InchesToPoints(0.75) * * * * .RightMargin = Application.InchesToPoints(0.75) * * * * .TopMargin = Application.InchesToPoints(1) * * * * .BottomMargin = Application.InchesToPoints(1) * * * * .HeaderMargin = Application.InchesToPoints(0.5) * * * * .FooterMargin = Application.InchesToPoints(0.5) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * With ActiveSheet.PageSetup * * * * .LeftMargin = Application.InchesToPoints(0.25) * * * * .RightMargin = Application.InchesToPoints(0.25) * * * * .TopMargin = Application.InchesToPoints(0.25) * * * * .BottomMargin = Application.InchesToPoints(0.25) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.18) * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = 1 * * ' * *.PrintErrors = -14012 * * End With * * *With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "Page &P of &N" * * * * .CenterFooter = "" * * * * .RightFooter = "&D" * * * * .LeftMargin = Application.InchesToPoints(0.33) * * * * .RightMargin = Application.InchesToPoints(0.29) * * * * .TopMargin = Application.InchesToPoints(0.34) * * * * .BottomMargin = Application.InchesToPoints(0.47) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.23) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * ActiveWindow.SelectedSheets.PrintPreview End Sub I have not seen the file in my inbox. Send to dguillett@ gmail.com (remove the space in the email addy)- Hide quoted text - - Show quoted text - Sorry, I got caught in the middle of something else. I just sent it. Thanks for your help. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro works but also runs original spreadsheet
On Aug 5, 4:40*pm, tbmarlie wrote:
On Aug 5, 1:59*pm, Don Guillett Excel MVP wrote: On Aug 5, 2:48*pm, tbmarlie wrote: On Aug 5, 11:49*am, Don Guillett Excel MVP wrote: At the very least, ALWAYS post your macro for comments. "If desired, send your file to dguillett I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results." I will also email the file to you, but here is the code to the macro. Sub FormatSUI() ' ' FormatSUI Macro ' Macro recorded 7/27/2010 by MarlieT ' ' Keyboard Shortcut: Ctrl+q ' * * Rows("1:2").Select * * Selection.Insert Shift:=xlDown * * Columns("A:R").Select * * Columns("A:R").EntireColumn.AutoFit * * ActiveWindow.SmallScroll ToRight:=-4 * * Range("D1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[-1]&"": ""&R[3]C[-1]" * * Range("E1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("F1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[11]&"": ""&R[3]C[11]" * * Range("G1").Select * * ActiveCell.FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" * * Range("D1:M1").Select * * Selection.Copy * * Range("D1").Select * * Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ * * * * :=False, Transpose:=False * * Columns("D:D").EntireColumn.AutoFit * * Columns("D:D").ColumnWidth = 15.57 * * Columns("C:C").Select * * Application.CutCopyMode = False * * Selection.Delete Shift:=xlToLeft * * Columns("M:M").Select * * Selection.Delete Shift:=xlToLeft * * Columns("N:N").Select * * Selection.Delete Shift:=xlToLeft * * Selection.Delete Shift:=xlToLeft * * Selection.NumberFormat = "mm/dd/yy;@" * * Columns("E:I").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Columns("K:L").Select * * Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)" * * Rows("3:3").Select * * Selection.Interior.ColorIndex = xlNone * * Selection.Font.Bold = True * * Range("C1:K1").Select * * Selection.Font.Bold = True * * Rows("4:4").Select * * ActiveWindow.FreezePanes = True * * Range("E3").Select * * Columns("G:L").Select * * Columns("G:L").EntireColumn.AutoFit * * Range("E3").Select * * *Dim wks As Worksheet * * *Dim LastCell As Range * * *Set wks = ActiveSheet * * *With wks * * * * *Set LastCell = .Cells(.Rows.Count, "E").End(xlUp) * * *End With * * *LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" * * *Columns("A:C").Select * * *With Selection * * * * .HorizontalAlignment = xlCenter * * * * .VerticalAlignment = xlBottom * * * * .Orientation = 0 * * * * .AddIndent = False * * * * .IndentLevel = 0 * * * * .ShrinkToFit = False * * * * .ReadingOrder = xlContext * * * * .MergeCells = False * * End With * * Range("A1").Select * * With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "" * * * * .CenterFooter = "" * * * * .RightFooter = "" * * * * .LeftMargin = Application.InchesToPoints(0.75) * * * * .RightMargin = Application.InchesToPoints(0.75) * * * * .TopMargin = Application.InchesToPoints(1) * * * * .BottomMargin = Application.InchesToPoints(1) * * * * .HeaderMargin = Application.InchesToPoints(0.5) * * * * .FooterMargin = Application.InchesToPoints(0.5) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * With ActiveSheet.PageSetup * * * * .LeftMargin = Application.InchesToPoints(0.25) * * * * .RightMargin = Application.InchesToPoints(0.25) * * * * .TopMargin = Application.InchesToPoints(0.25) * * * * .BottomMargin = Application.InchesToPoints(0.25) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.18) * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = 1 * * ' * *.PrintErrors = -14012 * * End With * * *With ActiveSheet.PageSetup * * * * .LeftHeader = "" * * * * .CenterHeader = "" * * * * .RightHeader = "" * * * * .LeftFooter = "Page &P of &N" * * * * .CenterFooter = "" * * * * .RightFooter = "&D" * * * * .LeftMargin = Application.InchesToPoints(0.33) * * * * .RightMargin = Application.InchesToPoints(0.29) * * * * .TopMargin = Application.InchesToPoints(0.34) * * * * .BottomMargin = Application.InchesToPoints(0.47) * * * * .HeaderMargin = Application.InchesToPoints(0.18) * * * * .FooterMargin = Application.InchesToPoints(0.23) * * * * .PrintHeadings = False * * * * .PrintGridlines = False * * * * .PrintComments = xlPrintNoComments * * * * .PrintQuality = 600 * * * * .CenterHorizontally = False * * * * .CenterVertically = False * * * * .Orientation = xlLandscape * * * * .Draft = False * * * * .PaperSize = xlPaperLetter * * * * .FirstPageNumber = xlAutomatic * * * * .Order = xlDownThenOver * * * * .BlackAndWhite = False * * * * .Zoom = False * * * * .FitToPagesWide = 1 * * * * .FitToPagesTall = False * * * * .PrintErrors = xlPrintErrorsDisplayed * * End With * * ActiveWindow.SelectedSheets.PrintPreview End Sub I have not seen the file in my inbox. Send to dguillett@ gmail.com (remove the space in the email addy)- Hide quoted text - - Show quoted text - Sorry, I got caught in the middle of something else. *I just sent it. Thanks for your help.- Hide quoted text - - Show quoted text - Sub OpenExcelFileToConvertSAS() Dim vFile As Variant myFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _ "*.xl*", 1, "SalesAid Software - Select Excel File to Convert", "Open", False) If TypeName(myFile) = "Boolean" Then Exit Sub Workbooks.Open myFile Call FormatSUI_SAS End Sub Sub FormatSUI_SAS() Application.ScreenUpdating = False Rows("1:2").Insert Shift:=xlDown Range("D1").FormulaR1C1 = "=R[2]C[-1]&"": ""&R[3]C[-1]" Range("E1").FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" Range("F1").FormulaR1C1 = "=R[2]C[11]&"": ""&R[3]C[11]" Range("G1").FormulaR1C1 = "=R[2]C[9]&"": ""&R[3]C[9]" Range("D1:M1").Copy Range("D1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Columns("D").ColumnWidth = 15.57 '=======see how it's done one line replaces all below Range("c1,n1,p1:q1").EntireColumn.Delete ' Columns("C").Delete Shift:=xlToLeft ' Columns("M").Delete Shift:=xlToLeft ' Columns("N:N").Select ' Selection.Delete Shift:=xlToLeft ' Selection.Delete Shift:=xlToLeft '=========== Columns("N").NumberFormat = "mm/dd/yy;@" Range("e1:i1,k1:l1").EntireColumn.NumberFormat = "#,##0.00_);[Red] (#,##0.00)" Rows(3).Interior.ColorIndex = xlNone Rows(3).Font.Bold = True Range("C1:K1").Font.Bold = True Set LastCell = Cells(Rows.Count, "E").End(xlUp) LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 = "=sum(r3c:r[-1]c)" With Columns("A:C") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With ActiveSheet.PageSetup 'delete NON necessary '.LeftHeader = "" '.CenterHeader = "" '.RightHeader = "" .LeftFooter = "Page &P of &N" '.CenterFooter = "" .RightFooter = "&D" .LeftMargin = Application.InchesToPoints(0.33) .RightMargin = Application.InchesToPoints(0.29) .TopMargin = Application.InchesToPoints(0.34) .BottomMargin = Application.InchesToPoints(0.47) .HeaderMargin = Application.InchesToPoints(0.18) .FooterMargin = Application.InchesToPoints(0.23) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 '.CenterHorizontally = False '.CenterVertically = False .Orientation = xlLandscape '.Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic '.Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintErrors = xlPrintErrorsDisplayed End With Columns.AutoFit Columns("f").ColumnWidth = 11 Rows(4).Select ActiveWindow.FreezePanes = True Application.ScreenUpdating = True ActiveWindow.SelectedSheets.PrintPreview End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VBA macro runs fine, but freezes if I try to do ANYTHING else whileit runs | Setting up and Configuration of Excel | |||
converting works data files to excel with original formats | New Users to Excel | |||
add a button on a spreadsheet that runs a macro | Excel Programming | |||
One macro runs then it auto runs another macro | Excel Discussion (Misc queries) | |||
Run macro but let user update spreadsheet while it runs | Excel Programming |