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!$A2ドル:$A247,ドルMATCH(1,--(SEARCH(TRANSPOSE(Lijst!$A2ドル:$A247ドル),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!$A2ドル:$A247,ドルMATCH(1,--(SEARCH(TRANSPOSE(Lijst!$A2ドル:$A247ドル),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.

asked Jan 23, 2020 at 8:03
\$\endgroup\$
4
  • \$\begingroup\$ Welcome to Code Review! Can you tell us more about what the code is doing and why? \$\endgroup\$ Commented Jan 23, 2020 at 10:50
  • \$\begingroup\$ Time allowing, try to get best value out of CodeReview@SE. \$\endgroup\$ Commented 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\$ Commented Jan 23, 2020 at 12:59
  • \$\begingroup\$ Also, Activate, Select and "Active-anything" are things to avoid \$\endgroup\$ Commented 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.

answered Jan 24, 2020 at 5:53
\$\endgroup\$
0

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.