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
Sᴀᴍ Onᴇᴌᴀ
29.5k16 gold badges45 silver badges201 bronze badges
asked Nov 22, 2017 at 18:58
\$\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\$ Commented 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\$ Commented 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 
answered Nov 26, 2017 at 15:13
\$\endgroup\$

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.