ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro works but also runs original spreadsheet (https://www.excelbanter.com/excel-programming/443463-macro-works-but-also-runs-original-spreadsheet.html)

tbmarlie

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.

Don Guillett Excel MVP

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

tbmarlie

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

Don Guillett Excel MVP

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)

tbmarlie

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.

Don Guillett Excel MVP

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


All times are GMT +1. The time now is 03:56 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com