0
\$\begingroup\$

I am learning to clean my code and make it more efficient, however I'm having trouble with my code, because most of the post about the subject are specified to a given code. The code below looks like a lot, but it's the same step for different sheets (the code below is for two sheets, there are five more sheets).

Sub Formule_Code()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Compliance
Worksheets("WIP extract").Activate
    Range("A1").Select
        LastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Range("A" & LastRow).Select
    Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Copy

Worksheets("Compliance").Activate
    LastRowC = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Range("A" & LastRowC).Select
            ActiveCell.PasteSpecial xlPasteAll

    'Kolom G
LastRowSumG_C = Cells(Rows.Count, 7).End(xlUp).Offset(-1, 0).Row
LastRowFormG_C = Cells(Rows.Count, 7).End(xlUp).Row

Range("G" & LastRowFormG_C).Formula = "=SUM(G42:G" & LastRowSumG_C & ")"
Range("E8").Formula = "=SUM(G42:G" & LastRowSumG_C & ")"

    'Kolom I
LastRowSumI_C = Cells(Rows.Count, 9).End(xlUp).Offset(-1, 0).Row
LastRowFormI_C = Cells(Rows.Count, 9).End(xlUp).Row

Range("I" & LastRowFormI_C).Formula = "=SUM(I42:I" & LastRowSumI_C & ")"
Range("F8").Formula = "=SUM(I42:I" & LastRowSumI_C & ")"

    'Kolom K
LastRowSumK_C = Cells(Rows.Count, 11).End(xlUp).End(xlUp).Offset(-1, 0).Row
LastRowFormK_C = Cells(Rows.Count, 11).End(xlUp).End(xlUp).Row

Range("K" & LastRowFormK_C).Formula = "=SUM(K42:K" & LastRowSumK_C & ")"
Range("G8").Formula = "=SUM(K42:K" & LastRowSumK_C & ")"

    'Kolom L
LastRowSumL_C = Cells(Rows.Count, 12).End(xlUp).End(xlUp).End(xlUp).Offset(-1, 0).Row
LastRowFormL_C = Cells(Rows.Count, 12).End(xlUp).End(xlUp).End(xlUp).Row

Range("L" & LastRowFormL_C).Formula = "=SUM(L42:L" & LastRowSumL_C & ")"
Range("H8").Formula = "=SUM(L42:L" & LastRowSumL_C & ")"

Range(Cells(Rows.Count, "L").End(xlUp).Offset(1), Cells(Rows.Count, "L")).EntireRow.Clear

Range("F11").Formula = "=SUM(H8 +- F12)"
Range("G11").Formula = "=SUM(H8 +- G12)"

LastRowStaff = Cells(Rows.Count, 4).End(xlUp).Offset().Row
LastRowExpense = Cells(Rows.Count, 12).End(xlUp).Offset(-5, 0).Row

Range("F12").Formula = "=SUMIF(D42:D" & LastRowStaff & ",""*Accrual*"", L42:L" & LastRowExpense & ")"
Range("G12").Formula = "=SUMIF(D42:D" & LastRowStaff & ",""*Accrual*"", L42:L" & LastRowExpense & ")"

Range("P42") = "Check"
Range("Q42") = "ID"

Range("P43").FormulaArray = "=IFERROR(INDEX(Lijst!$A$2:$A$247,MATCH(1,--(SEARCH(TRANSPOSE(Lijst!$A$2:$A$247),O43)>0),0),0),""Z"")"
    Range("P43").Select
        Selection.AutoFill Destination:=Range("P43:P1000")

Range("Q43").Formula = "=IF(P43<>P44,1,0)"
    Range("Q43").Select
        Selection.AutoFill Destination:=Range("Q43:Q1000")

    Rows("42:42").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Compliance").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Compliance").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("P42"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Compliance").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Columns("P:Q").Select
    Range("P25").Activate
    Selection.EntireColumn.Hidden = True

Dim rngc As Range, rc As Long

Set rngc = Range("Q8:Q3276")

For rc = rngc.Count To 1 Step -1
    If rngc(rc).Value = 1 Then
        rngc(rc + 1).EntireRow.Insert
        rngc(rc + 1).EntireRow.Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A35").Select

    End If
Next rc

    Columns("R:R").Select
    Range("R31").Activate
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Clear
    Range("O31").Select

Application.Goto Reference:=Range("a1"), Scroll:=True


'-----------------------------
'Advies
Worksheets("WIP extract").Activate
    Range("A" & LastRow).Select
        Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Copy

Worksheets("Advies").Activate
    LastRowA = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Range("A" & LastRowA).Select
            ActiveCell.PasteSpecial xlPasteAll

    'Kolom G
LastRowSumG_A = Cells(Rows.Count, 7).End(xlUp).Offset(-1, 0).Row
LastRowFormG_A = Cells(Rows.Count, 7).End(xlUp).Row

Range("G" & LastRowFormG_A).Formula = "=SUM(G42:G" & LastRowSumG_A & ")"
Range("E8").Formula = "=SUM(G42:G" & LastRowSumG_A & ")"

    'Kolom I
LastRowSumI_A = Cells(Rows.Count, 9).End(xlUp).Offset(-1, 0).Row
LastRowFormI_A = Cells(Rows.Count, 9).End(xlUp).Row

Range("I" & LastRowFormI_A).Formula = "=SUM(I42:I" & LastRowSumI_A & ")"
Range("F8").Formula = "=SUM(I42:I" & LastRowSumI_A & ")"

    'Kolom K
LastRowSumK_A = Cells(Rows.Count, 11).End(xlUp).End(xlUp).Offset(-1, 0).Row
LastRowFormK_A = Cells(Rows.Count, 11).End(xlUp).End(xlUp).Row

Range("K" & LastRowFormK_A).Formula = "=SUM(K42:K" & LastRowSumK_A & ")"
Range("G8").Formula = "=SUM(K42:K" & LastRowSumK_A & ")"

    'Kolom L
LastRowSumL_A = Cells(Rows.Count, 12).End(xlUp).End(xlUp).End(xlUp).Offset(-1, 0).Row
LastRowFormL_A = Cells(Rows.Count, 12).End(xlUp).End(xlUp).End(xlUp).Row

Range("L" & LastRowFormL_A).Formula = "=SUM(L42:L" & LastRowSumL_A & ")"
Range("H8").Formula = "=SUM(L42:L" & LastRowSumL_A & ")"

Range(Cells(Rows.Count, "L").End(xlUp).Offset(1), Cells(Rows.Count, "L")).EntireRow.Clear

Range("F11").Formula = "=SUM(H8 +- F12)"
Range("G11").Formula = "=SUM(H8 +- G12)"

LastRowStaff = Cells(Rows.Count, 4).End(xlUp).Offset().Row
LastRowExpense = Cells(Rows.Count, 12).End(xlUp).Offset(-5, 0).Row

Range("F12").Formula = "=SUMIF(D42:D" & LastRowStaff & ",""*Accrual*"", L42:L" & LastRowExpense & ")"
Range("G12").Formula = "=SUMIF(D42:D" & LastRowStaff & ",""*Accrual*"", L42:L" & LastRowExpense & ")"

Range("P42") = "Check"
Range("Q42") = "ID"

Range("P43").FormulaArray = "=IFERROR(INDEX(Lijst!$A$2:$A$247,MATCH(1,--(SEARCH(TRANSPOSE(Lijst!$A$2:$A$247),O43)>0),0),0),""Z"")"
    Range("P43").Select
        Selection.AutoFill Destination:=Range("P43:P1000")

Range("Q43").Formula = "=IF(P43<>P44,1,0)"
    Range("Q43").Select
        Selection.AutoFill Destination:=Range("Q43:Q1000")

    Rows("42:42").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Advies").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Advies").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("P42"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Advies").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Columns("P:Q").Select
    Range("P25").Activate
    Selection.EntireColumn.Hidden = True

Dim rnga As Range, ra As Long

Set rnga = Range("Q8:Q3276")

For ra = rnga.Count To 1 Step -1
    If rnga(ra).Value = 1 Then
        rnga(ra + 1).EntireRow.Insert
        rnga(ra + 1).EntireRow.Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A35").Select

    End If
Next ra

    Columns("R:R").Select
    Range("R31").Activate
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Clear
    Range("O31").Select

Application.Goto Reference:=Range("a1"), Scroll:=True

Any suggestions / help is appreciated.

\$\endgroup\$
4
  • \$\begingroup\$ Welcome to Code Review! Can you tell us more about what the code is doing and why? \$\endgroup\$
    – Mast
    Jan 23, 2020 at 10:50
  • \$\begingroup\$ Time allowing, try to get best value out of CodeReview@SE. \$\endgroup\$
    – greybeard
    Jan 23, 2020 at 12:33
  • \$\begingroup\$ See this SO question... that's a good start. Also any time you have Range or Cells or Rows or Columns, etc., make sure they are qualified with the Workbook and Worksheet they are in/on. \$\endgroup\$
    – BigBen
    Jan 23, 2020 at 12:59
  • \$\begingroup\$ Also, Activate, Select and "Active-anything" are things to avoid \$\endgroup\$
    – SmileyFtW
    Jan 23, 2020 at 13:32

1 Answer 1

2
\$\begingroup\$

This review is going to be short, because it will cover ground that has been covered many times in Code Review. Searching previous articles should provide more information.

  1. Use Option Explicit at the top of modules every time. Always. Always (search: Option Explicit).
  2. Properly indent your code for readability and maintainability. (search: indent code)
  3. Avoid using select and activate unless you particularly want to draw something to the user's attention. (https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba is a good start as @BigBen noted).
  4. Always fully qualify any reference to Range or Cells. Using a qualified With block does count. (search: qualify ranges)

Once the basics have been addressed, the code itself (as intended, not as currently presented) can then be reviewed. At the moment it is a bit too hard to read.

Why do you have .End three times?

Cells(Rows.Count, 12).End(xlUp).End(xlUp).End(xlUp).Row

An additional hint is to declare and assign a Workbook and Worksheet object for the book/sheet(s) that you want to manipulate. When using the variable, the VBA IDE Intellisense will function and aid you in useful properties and methods. When not assigned to a variable, these commands (e.g. ActiveWorkbook.Worksheets("WIP extract")) will return a generic Object and the Intellisense does not function.

\$\endgroup\$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.