2
\$\begingroup\$

The code below does the following:

  1. 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.
  2. If the scenarios match, then the code will drop in 0s and 1s onto another sheet in a formulated range
  3. 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
\$\endgroup\$
2
  • \$\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\$ 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\$ Nov 26, 2017 at 18:12

1 Answer 1

1
\$\begingroup\$

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 
\$\endgroup\$

Your Answer

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

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