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.
1 Answer 1
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.
- Use
Option Explicit
at the top of modules every time. Always. Always (search: Option Explicit). - Properly indent your code for readability and maintainability. (search: indent code)
- 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).
- 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.
Range
orCells
orRows
orColumns
, etc., make sure they are qualified with theWorkbook
andWorksheet
they are in/on. \$\endgroup\$