VBA code to read Excel file and conditionally complete formulas based on the contents

Question

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

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