V
Vacuum Sealed
Hi All
This code is one of the best codes I use in the stable of codes I have
collected over time which programatically counts or sums multiple columns
without the need for nested formulas, and I have modded it to suit my
purpose, although on this occasion, I need to add a condition for the
CountIf()** section of it.
Each of the ranges have either "OK" or "NO" in their respective columns.
What I need is to only count "NO" whereas in it's current state, it returns
all cells that are not "".
Code:
Sub Process_Drivers()
Dim vData, vaData()
Dim sTemp As String, i As Integer, lRows As Long
Dim rngNames As Range, rngHrs As Range, rngBreaks As Range, rngPreOp As
Range, rngSigned As Range
wksTarget As Worksheet
Set wksTarget = Sheets("Charting")
Set rngNames = Sheets("Summary").Range("$E$5:$E$15000")
Set rngHrs = Sheets("Summary").Range("$G$5:$G$15000")
Set rngBreaks = Sheets("Summary").Range("$H$5:$H$15000")
Set rngPreOp = Sheets("Summary").Range("$I$5:$I$15000")
Set rngSigned = Sheets("Summary").Range("$J$5:$J$15000")
vData = rngNames
For i = 1 To UBound(vData)
If Not InStr(1, sTemp, vData(i, 1), vbTextCompare) > 0 Then _
sTemp = sTemp & "~" & vData(i, 1)
Next
sTemp = Mid$(sTemp, 2): vData = Split(sTemp, "~")
lRows = UBound(vData) + 1: ReDim vaData(1 To lRows, 1 To 5)
vaData(1, 1) = "Drivers Name": vaData(1, 2) = "Hours Worked": vaData(1, 3)
= "Breaks Taken": vaData(1, 4) = "Pre-Op Checks": vaData(1, 5) = "Sheet
Signed"
For i = 5 To lRows
**
vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 4) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 5) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
Next
wksTarget.Range("$A$3").Resize(UBound(vaData), 5) = vaData
Sheets("Charting").Select
Range("A4").Select
Range("A4:E60").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub
Appreciate any pointers..
TIA
Mick
This code is one of the best codes I use in the stable of codes I have
collected over time which programatically counts or sums multiple columns
without the need for nested formulas, and I have modded it to suit my
purpose, although on this occasion, I need to add a condition for the
CountIf()** section of it.
Each of the ranges have either "OK" or "NO" in their respective columns.
What I need is to only count "NO" whereas in it's current state, it returns
all cells that are not "".
Code:
Sub Process_Drivers()
Dim vData, vaData()
Dim sTemp As String, i As Integer, lRows As Long
Dim rngNames As Range, rngHrs As Range, rngBreaks As Range, rngPreOp As
Range, rngSigned As Range
wksTarget As Worksheet
Set wksTarget = Sheets("Charting")
Set rngNames = Sheets("Summary").Range("$E$5:$E$15000")
Set rngHrs = Sheets("Summary").Range("$G$5:$G$15000")
Set rngBreaks = Sheets("Summary").Range("$H$5:$H$15000")
Set rngPreOp = Sheets("Summary").Range("$I$5:$I$15000")
Set rngSigned = Sheets("Summary").Range("$J$5:$J$15000")
vData = rngNames
For i = 1 To UBound(vData)
If Not InStr(1, sTemp, vData(i, 1), vbTextCompare) > 0 Then _
sTemp = sTemp & "~" & vData(i, 1)
Next
sTemp = Mid$(sTemp, 2): vData = Split(sTemp, "~")
lRows = UBound(vData) + 1: ReDim vaData(1 To lRows, 1 To 5)
vaData(1, 1) = "Drivers Name": vaData(1, 2) = "Hours Worked": vaData(1, 3)
= "Breaks Taken": vaData(1, 4) = "Pre-Op Checks": vaData(1, 5) = "Sheet
Signed"
For i = 5 To lRows
**
vaData(i, 1) = vData(i - 1)
vaData(i, 2) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 3) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 4) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
vaData(i, 5) = Application.WorksheetFunction.CountIf(rngNames, vData(i -
1))
Next
wksTarget.Range("$A$3").Resize(UBound(vaData), 5) = vaData
Sheets("Charting").Select
Range("A4").Select
Range("A4:E60").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub
Appreciate any pointers..
TIA
Mick