Macro works but also runs original spreadsheet

T

tbmarlie

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

Don Guillett Excel MVP

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

tbmarlie

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."
Click to expand...

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
 
D

Don Guillett Excel MVP

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."
Click to expand...

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
Click to expand...

I have not seen the file in my inbox. Send to dguillett@ gmail.com
(remove the space in the email addy)
 
T

tbmarlie

On Aug 5, 11:49 am, Don Guillett Excel MVP <[email protected]>
wrote:
Click to expand...
I will also email the file to you, but here is the code to the macro.
Click to expand...
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
Click to expand...
    Columns("G:L").Select
    Columns("G:L").EntireColumn.AutoFit
    Range("E3").Select
Click to expand...
     Dim wks As Worksheet
     Dim LastCell As Range
Click to expand...
     Set wks = ActiveSheet
Click to expand...
     With wks
         Set LastCell = .Cells(.Rows.Count, "E").End(xlUp)
     End With
Click to expand...
     LastCell.Offset(1, 0).Resize(1, 8).FormulaR1C1 =
"=sum(r3c:r[-1]c)"
Click to expand...
     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
Click to expand...

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 -
Click to expand...

Sorry, I got caught in the middle of something else. I just sent it.
Thanks for your help.
 
D

Don Guillett Excel MVP

On Aug 5, 11:49 am, Don Guillett Excel MVP <[email protected]>
wrote:
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."
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
Click to expand...
Click to expand...
I have not seen the file in my inbox. Send to dguillett@ gmail.com
(remove the space in the email addy)- Hide quoted text -
Click to expand...
- Show quoted text -
Click to expand...

Sorry, I got caught in the middle of something else.  I just sent it.
Thanks for your help.- Hide quoted text -

- Show quoted text -
Click to expand...

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() '(e-mail address removed)
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

including macro in protected worksheet 2
Formatting via VBA 3
Select next blank cell in column, before running macro 2
Macro to generate powerpoint slides 43
Moving Macros to the Application Level 2
Data exchange between macro and spreadsheet 1
Macro Adjust Based on Dataset? 1
Interactive spreadsheet column select 3

Top