- Look throughat rows starting at row 10 and continuing through the lastrowlast 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.
Option Explicit
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
