Code needs cleaning up

**hambone** · 07-08-2010, 12:01 PM

The below code is something I've inherited and I'm pretty sure it's a complete mess. I would really like to clean it up by removing anything unecessary or redundant. My ultimate goal is to make this code much shorter and more efficient. But alas, I'm a novice with this kind of stuff.

Any help is greatly appreciated.

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Sheet1").Select
    Range("B2:E21").Select
    Selection.Copy
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I2:I21") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("G2:J21")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND('Sheet1'!RC[12]>0,'Sheet1'!RC[12]<>""""),'Sheet1'!R1C2,"""")"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND('Sheet1'!RC[11]>0,'Sheet 1'!RC[12]<>""""),'Sheet1'!RC[5],"""")"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND('Sheet1'!RC[10]>0,'Sheet1'!RC[12]<>""""),'Sheet1'!RC[5],"""")"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND('Sheet1'!RC[9]>0,'Sheet 1'!RC[12]<>""""),'Sheet1'!RC[5],"""")"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND('Sheet1'!RC[8]>0,'Sheet1'!RC[12]<>""""),'Sheet1'!RC[5],"""")"
    Range("A2:E2").Select
    Selection.AutoFill Destination:=Range("A2:E25"), Type:=xlFillDefault
    Range("A2:E25").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H14").Select
    Application.CutCopyMode = False
    Range("A2:E25").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
        "A2:A25"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
        "D2:D25"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
        "B2:B25"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range( _
        "C2:C25"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A2:E25")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2:E25").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("Sheet1").Select
    Range("G2:J21").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Sheet2").Select
    Range("G6").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-4]C[-6]="""",""NONE!!"","""")"
    Range("G6").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Thanks guys

**Marcol** · 07-08-2010, 12:34 PM

Try this to start with
Check it does the same, I might have got a bit lost.

[EDIT]
code revisited after comments in Post #3

Sub Macro2()
    
    With Sheets("Sheet1")
        .Range("B2:E21").Copy
        .Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                  SkipBlanks:=False, Transpose:=False
    End With
    With Sheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I2:I21"), SortOn:=xlSortOnValues, _
                        Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("G2:J21")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    With Sheets("Sheet2")
        .Range("A2").Formula = "=IF(AND(Sheet1!M2>0,Sheet1!M2<>""""),Sheet1!$B$1,"""")"
        .Range("B2").Formula = "=IF(AND(Sheet1!$M$2>0,Sheet1!N$2<>""""),Sheet1!G$2,"""")"
        .Range("B2:E2").FillRight
        .Range("A2:E25").FillDown
        .Range("A2:E25").Copy
        .Range("A2:E25").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                      SkipBlanks:=False, Transpose:=False
    End With
    With Sheets("Sheet2").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A25"), SortOn:=xlSortOnValues, _
                             Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("D2:D25"), SortOn:=xlSortOnValues, _
                             Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("B2:B25"), SortOn:=xlSortOnValues, _
                             Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("C2:C25"), SortOn:=xlSortOnValues, _
                             Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange Range("A2:E25")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet2").Range("F1").ClearContents
    
    Sheets("Sheet1").Range("G2:J21").ClearContents
    
    With Sheets("Sheet2")
        If .Range("A2") <> "" Then
            .Range("G6") = ""
        Else
            .Range("G6") = "NONE!!"
        End If
    End With
    
End Sub

Check your formulae, I can't confirm they do as you want.
Also
Check your sort criteria

Hope this helps

**hambone** · 07-08-2010, 01:04 PM

Thanks Marcol. I appreciate your help.

When I run your macro, a couple of things happen:

The second line of the code (Range("G2").....) pastes the values in Sheet 2, which is where a form button is located with this macro assigned to it.

Also, as the macro is running, it tries to open a file three different times and I'm afraid I don't have any idea what would cause that.

Again, thanks for your help.

**Marcol** · 07-08-2010, 01:13 PM

Got to break a while I'll check later.

**Marcol** · 07-09-2010, 10:51 AM

1/.

The second line of the code (Range("G2").....) pastes the values in Sheet 2, which is where a form button is located with this macro assigned to it.

That's where you ask for it to go! Shift the button, or change the destination cell.

2/.

as the macro is running, it tries to open a file three different times

Check the number of times your formulae calls 'Sheet 1' instead of 'Sheet1', this looks like the source of this error.

Rather than clutter the BB with useless code, I have edited Post #2.
I have corrected what I see as errors, and simplified as much as I can confidentlly can.

Check that revised code out

Hope this helps