Share via

VBA -- cleanup code

Anonymous
2010-10-16T02:50:48+00:00

I wrote the following code to  format raw data for easier use.  It works well but I'm seeking help to 'clean' it up,  make it more direct and less lines of code.   Evan

Sub SRNetOpenStyleFormat()

'

' SRNetOpenStyleFormat Macro

' Macro recorded 10/15/2010 by ewilder

'

'

    Dim WS As Worksheet

    Set WS = Sheets.Add

    WS.Name = "SR Net Open Style"

    Sheets("MDMQ11").Select

    Cells.Select

    Range("H34").Activate

    Selection.Copy

    Sheets("SR Net Open Style").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    With Selection.Font

        .Name = "Arial"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

    End With

    Rows("1:1").Select

    Selection.Insert Shift:=xlDown

    Range("A1").Select

    ActiveCell.FormulaR1C1 = "Style"

    Range("B1").Select

    ActiveCell.FormulaR1C1 = "Acct"

    Range("C1").Select

    ActiveCell.FormulaR1C1 = "SR"

    Range("D1").Select

    ActiveCell.FormulaR1C1 = "PT"

    Range("E1").Select

    ActiveCell.FormulaR1C1 = "Style"

    Range("F1").Select

    ActiveCell.FormulaR1C1 = "S"

    Range("G1").Select

    ActiveCell.FormulaR1C1 = "KC"

    Range("J1").Select

    ActiveCell.FormulaR1C1 = "Order #"

    Range("K1").Select

    ActiveCell.FormulaR1C1 = "Line#"

    Range("L1").Select

    ActiveCell.FormulaR1C1 = "ship ret inv"

    Range("M1").Select

    ActiveCell.FormulaR1C1 = "Memo"

    Range("N1").Select

    ActiveCell.FormulaR1C1 = "Date"

    Range("O1").Select

    ActiveCell.FormulaR1C1 = "Weight"

    Range("P1").Select

    ActiveCell.FormulaR1C1 = "Onhand Units"

    Range("Q1").Select

    ActiveCell.FormulaR1C1 = "Sells"

    Range("W1").Select

    ActiveCell.FormulaR1C1 = "Returned Units"

    Range("A1:W1").Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .ShrinkToFit = False

        .MergeCells = False

    End With

    Selection.Font.Bold = True

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .ShrinkToFit = False

        .MergeCells = False

    End With

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    With Selection.Interior

        .ColorIndex = 15

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

    Rows("2:2").Select

    ActiveWindow.FreezePanes = True

    Columns("A:C").Select

    Selection.EntireColumn.Hidden = True

    Columns("G:I").Select

    Selection.EntireColumn.Hidden = True

    Columns("L:P").Select

    Selection.EntireColumn.Hidden = True

    Columns("R:V").Select

    Selection.EntireColumn.Hidden = True

    Columns("W:W").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    Range("Y20").Select

End Sub

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

Answer accepted by question author

Anonymous
2010-10-16T08:49:37+00:00

Look at this, where all select statements has been left out, using the range reference to manipulate the cell(s).

Sub SRNetOpenStyleFormat()

'

' SRNetOpenStyleFormat Macro

' Macro recorded 10/15/2010 by ewilder

'

'

 Dim WS As Worksheet

 Sheets("MDMQ11").Copy After:=Sheets(Sheets.Count)

 Set WS = Sheets(Sheets.Count)

 WS.Name = "SR Net Open Style"

WS.Activate

 With Cells.Font

     .Name = "Arial"

     .Size = 8

     .Strikethrough = False

     .Superscript = False

     .Subscript = False

     .OutlineFont = False

     .Shadow = False

     .Underline = xlUnderlineStyleNone

     .ColorIndex = xlAutomatic

 End With

 Rows("1:1").Insert Shift:=xlDown

 Range("A1").FormulaR1C1 = "Style"

 Range("B1").FormulaR1C1 = "Acct"

 Range("C1").FormulaR1C1 = "SR"

 Range("D1").FormulaR1C1 = "PT"

 Range("E1").FormulaR1C1 = "Style"

 Range("F1").FormulaR1C1 = "S"

 Range("G1").FormulaR1C1 = "KC"

 Range("J1").FormulaR1C1 = "Order #"

 Range("K1").FormulaR1C1 = "Line#"

 Range("L1").FormulaR1C1 = "ship ret inv"

 Range("M1").FormulaR1C1 = "Memo"

 Range("N1").FormulaR1C1 = "Date"

 Range("O1").FormulaR1C1 = "Weight"

 Range("P1").FormulaR1C1 = "Onhand Units"

 Range("Q1").FormulaR1C1 = "Sells"

 Range("W1").FormulaR1C1 = "Returned Units"

 With Range("A1:W1")

     .HorizontalAlignment = xlCenter

     .VerticalAlignment = xlBottom

     .WrapText = True

     .Orientation = 0

     .AddIndent = False

     .ShrinkToFit = False

     .MergeCells = False

     .Font.Bold = True

     .Borders(xlDiagonalDown).LineStyle = xlNone

     .Borders(xlDiagonalUp).LineStyle = xlNone

     With Range("A1").Borders(xlEdgeLeft)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

     With .Borders(xlEdgeTop)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

     With .Borders(xlEdgeBottom)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

     With Range("W1").Borders(xlEdgeRight)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

     .Borders(xlInsideVertical).LineStyle = xlNone

     With .Interior

         .ColorIndex = 15

         .Pattern = xlSolid

         .PatternColorIndex = xlAutomatic

     End With

     With Columns("W:W")

     .Borders(xlDiagonalDown).LineStyle = xlNone

     .Borders(xlDiagonalUp).LineStyle = xlNone

     With .Borders(xlEdgeLeft)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

     With .Borders(xlEdgeTop)

         .LineStyle = xlContinuous

         .Weight = xlMedium

         .ColorIndex = xlAutomatic

     End With

 End With

 End With

Range("A2").Select

ActiveWindow.FreezePanes = True

Columns("A:C").EntireColumn.Hidden = True

Columns("G:I").EntireColumn.Hidden = True

Columns("L:P").EntireColumn.Hidden = True

Columns("R:V").EntireColumn.Hidden = True

Range("Y20").Select

End Sub

Regards,

Per

Was this answer helpful?

0 comments No comments

1 additional answer

Sort by: Most helpful
  1. Anonymous
    2010-11-15T11:36:25+00:00

    Thankyou so much -- works great

    Was this answer helpful?

    0 comments No comments