View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Living the Dream Living the Dream is offline
external usenet poster
 
Posts: 151
Default Counting & Summing Multiple criteria over variable row range

*** SOLVED ***

I knew from the outset this was going to be somewhat complex and daunting, particularly if you haven't had any exposure to Transport or Logistics. So, ( Not that I came to the decsion lightly as I would not normwlly do this ) as time was running out, I approached Claus directly for two reasons.

1. My limited Time-frame involved
2. Large amount of back and forth traffic

Essentially, the two main reasons I am here replying and closing off this post is to firstly, publicly proclaim my utter gratitude to Claus for his amazing dilligence and patience in assiting me with his amazing talent in resolving this epic endeavour given he had zero understanding of just what it was he got himeslf into with no knowledge in the area I operate in; it was very humbling for me, even after all my attempts to recompence him, he brushed it off citing his happiness to assist me.

It is heart-lifting to know there is a global community of like minded, generous people willing to go the distance for a total stranger half a world away.

Now, for the second reason; I thought it fitting that Claus' hard work be put on display, so that anyone who happens to need something similar in the future, they need not look any further that this awesome peice of code:

Eternally Gratefull to you Claus!

Cheers
Mark.

Dim sMain As Worksheet
Dim myPreLoads As Range, my0409Loads As Range, my0912Loads As Range, my1215Loads As Range, my1500Loads As Range, myTotalLoads As Range
Dim myPreWoods As Range, my0409Woods As Range, my0912Woods As Range, my1215Woods As Range, my1500Woods As Range, myTotalWoods As Range
Dim n As Long, LRow As Long, i As Long, j As Long
Dim dest As Range, myRngL As Range, myRngW As Range, c As Range
Dim varTmp As Variant, varRoute As Variant, varTime As Variant
Dim DicRoute As Object, dicTime As Object
Dim DC As Range, Loads As Range, Woods As Range, Route As Range, Arr As Range, VehType As Range, Hub As Range
Dim myTime As Double

Set DicRoute = CreateObject("scripting.dictionary")
Set dicTime = CreateObject("scripting.dictionary")

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
On Error GoTo CleanUp

Set sMain = Sheets("Main")
With sMain
LRow = .Cells(.Rows.Count, "O").End(xlUp).Row
n = Application.Match("Loads", .Range("G:G"), 0)
Set dest = .Cells(n, "G")

With .Range("N2:N" & LRow)
.NumberFormat = "hh:mm"
.TextToColumns Destination:=.Range("N2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
End With

Set myPreLoads = dest.Offset(1, 0)
Set my0409Loads = dest.Offset(2, 0)
Set my0912Loads = dest.Offset(3, 0)
Set my1215Loads = dest.Offset(4, 0)
Set my1500Loads = dest.Offset(5, 0)
Set myTotalLoads = dest.Offset(7, 0)

Set myPreWoods = dest.Offset(1, 2)
Set my0409Woods = dest.Offset(2, 2)
Set my0912Woods = dest.Offset(3, 2)
Set my1215Woods = dest.Offset(4, 2)
Set my1500Woods = dest.Offset(5, 2)
Set myTotalWoods = dest.Offset(7, 2)
Set Hub = dest.Offset(7, 4)

Set DC = .Range("F2:F" & LRow)
Set Loads = .Range("L2:L" & LRow)
Set Woods = .Range("I2:I" & LRow)
Set Route = .Range("J2:J" & LRow)
Set Arr = .Range("N2:N" & LRow)
Set VehType = .Range("O2:O" & LRow)

varTmp = .Range("J2:J" & LRow)
For i = LBound(varTmp) To UBound(varTmp)
DicRoute(varTmp(i, 1)) = Right(varTmp(i, 1), 4)
Next
varRoute = DicRoute.items

varTmp = .Range("N2:N" & LRow)
For i = LBound(varTmp) To UBound(varTmp)
dicTime(varTmp(i, 1)) = varTmp(i, 1)
Next

varTime = dicTime.items
For i = LBound(varRoute) To UBound(varRoute)
For j = LBound(varTime) To UBound(varTime)
Select Case varTime(j)
Case TimeSerial(4, 0, 0) To TimeSerial(9, 0, 0)
Set myRngL = my0409Loads
Set myRngW = my0409Woods
Case TimeSerial(9, 0, 0) To TimeSerial(12, 0, 0)
Set myRngL = my0912Loads
Set myRngW = my0912Woods
Case TimeSerial(12, 0, 0) To TimeSerial(15, 0, 0)
Set myRngL = my1215Loads
Set myRngW = my1215Woods
Case Is TimeSerial(15, 0, 0)
Set myRngL = my1500Loads
Set myRngW = my1500Woods
End Select

If Application.CountIfs(Arr, varTime(j), Route, "*" & varRoute(i), DC, "HDC", Loads, "PRELOAD") 0 Then
myPreLoads = Application.CountIfs(Loads, "PRELOAD")
myPreWoods = myPreWoods + Application.SumIfs(Woods, DC, "HDC", Route, "*" & varRoute(i), Arr, varTime(j), Loads, "PRELOAD")
ElseIf Application.CountIfs(Arr, varTime(j), Route, "*" & varRoute(i), DC, "HDC") 0 Then
myRngL = myRngL + 1
myRngW = myRngW + Application.SumIfs(Woods, DC, "HDC", Route, "*" & varRoute(i), Arr, varTime(j))
End If
If Application.CountIfs(Arr, varTime(j), Route, "*" & varRoute(i), DC, "HDC") 0 And _
Application.CountIfs(Arr, varTime(j), Route, "*" & varRoute(i), DC, "RDC") 0 Then
myRngW.Offset(, 4) = myRngW.Offset(, 4) + Application.SumIfs(Woods, DC, "HDC", Route, "*" & varRoute(i), Arr, varTime(j), VehType, "R")
myRngW.Offset(, 5) = myRngW.Offset(, 5) + Application.SumIfs(Woods, DC, "HDC", Route, "*" & varRoute(i), Arr, varTime(j), VehType, "S")
End If
Next
Next
myTotalLoads = Application.Sum(dest.Offset(1).Resize(5))
myTotalWoods = Application.Sum(dest.Offset(1, 2).Resize(5))
myTotalWoods.Offset(, 4) = Application.Sum(dest.Offset(1, 6).Resize(5))
myTotalWoods.Offset(, 5) = Application.Sum(dest.Offset(1, 7).Resize(5))
End With

Range("A1").Select

Application.Wait (Now + myTI * 250)

CleanUp:

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With

End Sub