The code below does the following:
- Look at rows starting at row 10 and continuing through the last row of a sheet, and based off certain criteria, loops through each row.
- If the scenarios match, then the code will drop in 0s and 1s onto another sheet in a formulated range
- In some scenarios, the code will fill down formulas.
The correct time to run is 3.5 seconds, I am wondering if there are any adjustments to speed this up.
Option Explicit
Sub CleanupCrew()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim icounter As Long
Dim lastrowB As Long
Dim lastrowd As Long
Dim a As Variant
Dim rw As Long
Set ws = Worksheets("Dashboard")
Set ws1 = Worksheets("Base")
Set ws2 = Worksheets("LOOKUP")
Set ws3 = Worksheets("Control")
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
lastrowB = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastrowd = ws.Cells(Rows.Count, 1).End(xlUp).Row
Application.Calculate
For icounter = 10 To lastrowd
Dim varL As Integer
Dim varM As Variant
varL = ws.Cells(icounter, "AD")
varM = ws.Cells(icounter, "AI")
a = ws.Cells(icounter, "AD")
'If proposed Box vacancy greater than 12
If ws.Cells(icounter, "AN") > 12 And ws.Cells(icounter, "AX") = "True" Then
rw = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws1.Cells(varM, a).Value = 1 - ws.Cells(icounter, "AE").Value
If a = 87 Then
ws1.Range(ws1.Cells(varM, a + 1), ws1.Cells(varM, 98)).Value = 0
ElseIf a = 98 Then
ws1.Range(ws1.Cells(varM, 87), ws1.Cells(varM, a - 1)).Value = 1
Else
ws1.Range(ws1.Cells(varM, 87), ws1.Cells(varM, a - 1)).Value = 1
ws1.Range(ws1.Cells(varM, a + 1), ws1.Cells(varM, 98)).Value = 0
End If
ws.Cells(rw, "A") = "Incumbent (Automated)"
ws.Cells(rw, "E").Value = ws.Cells(icounter, "N").Value
ws.Cells(rw, "B").Value = ws.Cells(icounter, "B").Value
ws.Cells(rw, "D").Value = Application.WorksheetFunction.VLookup(ws.Cells(rw, "E"), ws3.Range("C:I"), 7, 0)
ws.Cells(rw, "A").AddComment " " & ws.Cells(rw, "D") & ". "
ws.Range("Y" & lastrowd & ":AS" & rw).FillDown
End If
If ws.Cells(icounter, "AM") > 12 And ws.Cells(icounter, "AY") = "True" Then
rw = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws1.Cells(varL, a).Value = 1 - ws.Cells(icounter, "Ae").Value
If a = 87 Then
ws1.Range(ws1.Cells(varL, a + 1), ws1.Cells(varL, 98)).Value = 0
ElseIf a = 98 Then
ws1.Range(ws1.Cells(varL, 87), ws1.Cells(varL, a - 1)).Value = 1
Else
ws1.Range(ws1.Cells(varL, 87), ws1.Cells(varL, a - 1)).Value = 1
ws1.Range(ws1.Cells(varL, a + 1), ws1.Cells(varL, 98)).Value = 0
End If
ws.Cells(rw, "A") = ")"
ws.Cells(rw, "E").Value = ws.Cells(icounter, "E").Value
ws.Cells(rw, "B").Value = ws.Cells(icounter, "B").Value
ws.Cells(rw, "D").Value = Application.WorksheetFunction.VLookup(ws.Cells(rw, "E"), ws3.Range("C:I"), 7, 0)
ws.Cells(rw, "A").AddComment "" & ws.Cells(rw, "D") & ". ."
ws.Range("Y" & lastrowd & ":AS" & rw).FillDown
End If
If ws.Cells(icounter, "AS") = True And ws.Cells(icounter, "A") <> "Termination" And ws.Cells(icounter, "Aw") = "True" Then
rw = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws.Cells(rw, "A") = ""
ws.Cells(rw, "E").Value = ws.Cells(icounter, "E").Value
ws.Cells(rw, "B").Value = ws.Cells(icounter, "B").Value
'ws.Cells(rw, "D") = Application.WorksheetFunction.VLookup(ws.Cells(rw, "E"), ws3.Range("C:I"), 7, 0)
ws.Cells(rw, "A").AddComment " " & ws.Cells(rw, "E") & " "
ws.Range("Y" & lastrowd & ":AS" & rw).FillDown
End If
Next icounter
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculate
End Sub
-
\$\begingroup\$ I changed the title to a different one that describes what the code does per site goals: "State what your code does in your title, not your main concerns about it.". Feel free to give it a different title if there is something more appropriate. \$\endgroup\$Sᴀᴍ Onᴇᴌᴀ– Sᴀᴍ Onᴇᴌᴀ ♦2017年11月22日 19:22:44 +00:00Commented Nov 22, 2017 at 19:22
-
\$\begingroup\$ Please use more descriptive names for variables than: "a", "rw", "ws". After a month you won't be able to make any change to that code. VBA is not an assembler code. And remember about proper formatting. Adding a tab/few extra spaces for inner blocks of "if"/loop construction make code more readable. \$\endgroup\$cezarypiatek– cezarypiatek2017年11月26日 18:12:44 +00:00Commented Nov 26, 2017 at 18:12
1 Answer 1
Some tips I suggest trying...
VarM
and a
shouldn’t be variants. I would change those to integers.
Overly abundant on counting loops, in this scenario you should loop a range through a named range.
Also use the .offset(1,0)
instead of adding 1 for rw. Use .offset(0,1)
instead of reading the cells(lastrow,"b")
. Set application.calculation
back to automatic at the end (I wouldn’t turn it off but depends on your data rows). Use with end with statements, it’ll help make the code more readable as well.
You have a lot of if else end if blocks. I would break that into a select case statement when a criteria is met for your formulas. I’m on my phone but I hope this makes enough sense for you to try. This is what the structure would look similar to:
with ws
for each cell in MyRNG
‘Select case for cell criteria
‘if statement here for formula criteria
‘End if
‘Next case statement here...
Next cell
End with