Hi KjBox , you created the below code for me previously and I would like it modified if possible. It uses Option Base 1.
I only need one Const, Post Work Manual
I need an extra WrkClss, SMOK
See code below, thanks in advance.
Code
Private Sub WorkPrograms()
'Work Programs
Dim x, y, Cols, ContAreas, WrkClss, i As Long, ii As Long, iii As Long
Const Category As String = "Standard of Work" 'NO LONGER EQUIRED*********
Const InspType As String = "Post Work Manual" 'ONLY NEED THIS*********
ContAreas = Array("SECA11", "SECA12", "SECA13", "SECA14", "SECA15", "SECA16")
Cols = Array(1, 4, 7, 10, 13, 16, 19, 22)
WrkClss = Array("UW", "PW", "VAC*", "MPWCAP", "MOD*", "LGC", "BES", "MPWA") 'NEED "SMOK" ADDED AFTER "MPWA"************
x = Sheets("calculations").[a6].CurrentRegion
ReDim y(1 To 6, 1 To 23)
For i = 2 To UBound(x, 1)
For ii = 1 To 6
If x(i, 3) = ContAreas(ii) And x(i, 7) = Category And x(i, 8) = InspType Then
For iii = 1 To 8
If IsEmpty(y(ii, Cols(iii))) Then y(ii, Cols(iii)) = 0
If IsEmpty(y(ii, Cols(iii) + 1)) Then y(ii, Cols(iii) + 1) = 0
If x(i, 4) Like WrkClss(iii) Then
If x(i, 9) = "Pass" Then
y(ii, Cols(iii)) = y(ii, Cols(iii)) + 1
Else
y(ii, Cols(iii) + 1) = y(ii, Cols(iii) + 1) + 1
End If
End If
Next
End If
Next
Next
With ActiveSheet
.[h5].Resize(6, 23) = y
.Activate
End With
End Sub
Display More